home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / modes / vhdl-mode.el.z / vhdl-mode.el
Encoding:
Text File  |  1998-05-21  |  91.7 KB  |  2,706 lines

  1. ;;; vhdl-mode.el --- major mode for editing VHDL code
  2.  
  3. ;; Copyright (C) 1994 - 1997 Rodney J. Whitby
  4. ;; Copyright (C) 1992, 1993, 1994 Barry A. Warsaw
  5. ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  6.  
  7. ;; Author:      Rodney J. Whitby <rwhitby@geocities.com>
  8. ;; Maintainer:      Rodney J. Whitby <rwhitby@geocities.com>
  9. ;; Created:      June 1994, adapted from cc-mode.el 4.29 by Barry A. Warsaw.
  10. ;; Version:      $Revision: 2.74 $
  11. ;; Last Modified: $Date: 1997/07/21 23:23:24 $
  12. ;; Keywords:      languages VHDL
  13. ;; Archive:      http://www.geocities.com/SiliconValley/Park/8287/
  14.  
  15. ;; NOTE: Read the commentary below for the right way to submit bug reports!
  16.  
  17. ;; This file is not yet part of GNU Emacs.
  18.  
  19. ;; GNU Emacs is free software; you can redistribute it and/or modify
  20. ;; it under the terms of the GNU General Public License as published by
  21. ;; the Free Software Foundation; either version 2, or (at your option)
  22. ;; any later version.
  23.  
  24. ;; GNU Emacs is distributed in the hope that it will be useful,
  25. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  26. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  27. ;; GNU General Public License for more details.
  28.  
  29. ;; You should have received a copy of the GNU General Public License
  30. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  31. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  32.  
  33. ;;; Commentary:
  34.  
  35. ;; This package provides indentation support for VHDL code.
  36.  
  37. ;; Details on VHDL-MODE are now contained in an accompanying texinfo
  38. ;; manual (vhdl-mode.texi).
  39.  
  40. ;; To submit bug reports, hit "C-c C-b", and please try to include a
  41. ;; code sample so I can reproduce your problem.  If you have other
  42. ;; questions contact me at the address listed at the top of this file.
  43.  
  44. ;; YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS. They are the result of
  45. ;; the multi-Emacsen support. FSF Emacs 19 and XEmacs 19 (formerly
  46. ;; Lucid) do things differently and there's no way to shut the
  47. ;; byte-compiler up at the necessary granularity.  Let me say this
  48. ;; again: YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS (you'd be
  49. ;; surprised at how many people don't follow this advice :-).
  50.  
  51. ;; To use VHDL-MODE, add the following to your .emacs file.  This
  52. ;; assumes you will use .vhd extensions for your VHDL source:
  53. ;;
  54. ;; (autoload 'vhdl-mode   "vhdl-mode" "VHDL Editing Mode" t)
  55. ;; (setq auto-mode-alist
  56. ;;   (append '(("\\.vhd$"  . vhdl-mode)   ; to edit VHDL code
  57. ;;            ) auto-mode-alist))
  58. ;;
  59. ;; If you would like to join the `vhdl-mode-announce' announcements
  60. ;; list or the `vhdl-mode-victims' beta testers list, send add/drop
  61. ;; requests to the address listed at the top of this file.
  62. ;;
  63. ;; Many, many thanks go out to all the folks on the beta test list.
  64. ;; Without their patience, testing, insight, and code contributions,
  65. ;; and encouragement vhdl-mode.el would be a far inferior package.
  66.  
  67. ;; LCD Archive Entry:
  68. ;; vhdl-mode.el|Rodney J. Whitby|rwhitby@geocities.com
  69. ;; |Major mode for editing VHDL code
  70. ;; |$Date: 1997/07/21 23:23:24 $|$Revision: 2.74 $
  71. ;; |http://www.geocities.com/SiliconValley/Park/8287/
  72.  
  73.  
  74. ;;; Code:
  75.  
  76. ;; user definable variables
  77. ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
  78.  
  79. (defgroup vhdl nil
  80.   "Major mode for editing VHDL code."
  81.   :group 'languages)
  82.  
  83.  
  84. (defcustom vhdl-inhibit-startup-warnings-p nil
  85.   "*If non-nil, inhibits start up compatibility warnings."
  86.   :type 'boolean
  87.   :group 'vhdl)
  88.  
  89. (defcustom vhdl-strict-syntax-p nil
  90.   "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
  91. If the syntactic symbol for a particular line does not match a symbol
  92. in the offsets alist, an error is generated, otherwise no error is
  93. reported and the syntactic symbol is ignored."
  94.   :type 'boolean
  95.   :group 'vhdl)
  96.  
  97. (defcustom vhdl-echo-syntactic-information-p nil
  98.   "*If non-nil, syntactic info is echoed when the line is indented."
  99.   :type 'boolean
  100.   :group 'vhdl)
  101.  
  102. (defcustom vhdl-basic-offset 2
  103.   "*Amount of basic offset used by + and - symbols in `vhdl-offsets-alist'."
  104.   :type 'integer
  105.   :group 'vhdl)
  106.  
  107. (defconst vhdl-offsets-alist-default
  108.   '((string                . -1000)
  109.     (block-open            . 0)
  110.     (block-close           . 0)
  111.     (statement             . 0)
  112.     (statement-cont        . vhdl-lineup-statement-cont)
  113.     (statement-block-intro . +)
  114.     (statement-case-intro  . +)
  115.     (case-alternative      . +)
  116.     (comment               . vhdl-lineup-comment)
  117.     (arglist-intro         . vhdl-lineup-arglist-intro)
  118.     (arglist-cont          . 0)
  119.     (arglist-cont-nonempty . vhdl-lineup-arglist)
  120.     (arglist-close         . vhdl-lineup-arglist)
  121.     (entity                . 0)
  122.     (configuration         . 0)
  123.     (package               . 0)
  124.     (architecture          . 0)
  125.     (package-body          . 0)
  126.     )
  127.   "Default settings for offsets of syntactic elements.
  128. Do not change this constant!  See the variable `vhdl-offsets-alist' for
  129. more information.")
  130.  
  131. (defcustom vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)
  132.   "*Association list of syntactic element symbols and indentation offsets.
  133. As described below, each cons cell in this list has the form:
  134.  
  135.     (SYNTACTIC-SYMBOL . OFFSET)
  136.  
  137. When a line is indented, vhdl-mode first determines the syntactic
  138. context of the line by generating a list of symbols called syntactic
  139. elements.  This list can contain more than one syntactic element and
  140. the global variable `vhdl-syntactic-context' contains the context list
  141. for the line being indented.  Each element in this list is actually a
  142. cons cell of the syntactic symbol and a buffer position.  This buffer
  143. position is call the relative indent point for the line.  Some
  144. syntactic symbols may not have a relative indent point associated with
  145. them.
  146.  
  147. After the syntactic context list for a line is generated, vhdl-mode
  148. calculates the absolute indentation for the line by looking at each
  149. syntactic element in the list.  First, it compares the syntactic
  150. element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'.  When it
  151. finds a match, it adds the OFFSET to the column of the relative indent
  152. point.  The sum of this calculation for each element in the syntactic
  153. list is the absolute offset for line being indented.
  154.  
  155. If the syntactic element does not match any in the `vhdl-offsets-alist',
  156. an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise
  157. the element is ignored.
  158.  
  159. Actually, OFFSET can be an integer, a function, a variable, or one of
  160. the following symbols: `+', `-', `++', or `--'.  These latter
  161. designate positive or negative multiples of `vhdl-basic-offset',
  162. respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is
  163. called with a single argument containing the cons of the syntactic
  164. element symbol and the relative indent point.  The function should
  165. return an integer offset.
  166.  
  167. Here is the current list of valid syntactic element symbols:
  168.  
  169.  string                 -- inside multi-line string
  170.  block-open             -- statement block open
  171.  block-close            -- statement block close
  172.  statement              -- a VHDL statement
  173.  statement-cont         -- a continuation of a VHDL statement
  174.  statement-block-intro  -- the first line in a new statement block
  175.  statement-case-intro   -- the first line in a case alternative block
  176.  case-alternative       -- a case statement alternative clause
  177.  comment                -- a line containing only a comment
  178.  arglist-intro          -- the first line in an argument list
  179.  arglist-cont           -- subsequent argument list lines when no
  180.                            arguments follow on the same line as the
  181.                            the arglist opening paren
  182.  arglist-cont-nonempty  -- subsequent argument list lines when at
  183.                            least one argument follows on the same
  184.                            line as the arglist opening paren
  185.  arglist-close          -- the solo close paren of an argument list
  186.  entity                 -- inside an entity declaration
  187.  configuration          -- inside a configuration declaration
  188.  package                -- inside a package declaration
  189.  architecture           -- inside an architecture body
  190.  package-body           -- inside a package body
  191. "
  192.   :type 'sexp
  193.   :group 'vhdl)
  194.  
  195. (defcustom vhdl-tab-always-indent t
  196.   "*Controls the operation of the TAB key.
  197. If t, hitting TAB always just indents the current line.  If nil,
  198. hitting TAB indents the current line if point is at the left margin or
  199. in the line's indentation, otherwise it insert a real tab character.
  200. If other than nil or t, then tab is inserted only within literals
  201. -- defined as comments and strings -- and inside preprocessor
  202. directives, but line is always reindented.
  203.  
  204. Note that indentation of lines containing only comments is also
  205. controlled by the `vhdl-comment-only-line-offset' variable."
  206.   :type '(radio (const :tag "Always indent" t)
  207.         (const :tag "Indent if point in indentation" nil)
  208.         (sexp :format "%t\n"
  209.               :tag "Insert if point within literals" other))
  210.   :group 'vhdl)
  211.  
  212. (defcustom vhdl-comment-only-line-offset 0
  213.   "*Extra offset for line which contains only the start of a comment.
  214. Can contain an integer or a cons cell of the form:
  215.  
  216.  (NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
  217.  
  218. Where NON-ANCHORED-OFFSET is the amount of offset given to
  219. non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is
  220. the amount of offset to give column-zero anchored comment-only lines.
  221. Just an integer as value is equivalent to (<val> . 0)"
  222.   :type '(choice integer
  223.          (cons :value (0 . 0)
  224.                (integer :tag "Non-anchored offset")
  225.                (integer :tag "Anchored offset")))
  226.   :group 'vhdl)
  227.  
  228. (defcustom vhdl-special-indent-hook nil
  229.   "*Hook for user defined special indentation adjustments.
  230. This hook gets called after a line is indented by the mode."
  231.   :type 'hook
  232.   :group 'vhdl)
  233.  
  234. (defvar vhdl-style-alist
  235.   '(("IEEE"
  236.      (vhdl-basic-offset . 4)
  237.      (vhdl-offsets-alist . ())
  238.      )
  239.     )
  240.   "Styles of Indentation.
  241. Elements of this alist are of the form:
  242.  
  243.   (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
  244.  
  245. where STYLE-STRING is a short descriptive string used to select a
  246. style, VARIABLE is any vhdl-mode variable, and VALUE is the intended
  247. value for that variable when using the selected style.
  248.  
  249. There is one special case when VARIABLE is `vhdl-offsets-alist'.  In this
  250. case, the VALUE is a list containing elements of the form:
  251.  
  252.   (SYNTACTIC-SYMBOL . VALUE)
  253.  
  254. as described in `vhdl-offsets-alist'.  These are passed directly to
  255. `vhdl-set-offset' so there is no need to set every syntactic symbol in
  256. your style, only those that are different from the default.")
  257.  
  258. ;; dynamically append the default value of most variables
  259. (or (assoc "Default" vhdl-style-alist)
  260.     (let* ((varlist '(vhdl-inhibit-startup-warnings-p
  261.               vhdl-strict-syntax-p
  262.               vhdl-echo-syntactic-information-p
  263.               vhdl-basic-offset
  264.               vhdl-offsets-alist
  265.               vhdl-tab-always-indent
  266.               vhdl-comment-only-line-offset))
  267.        (default (cons "Default"
  268.               (mapcar
  269.                (function
  270.                 (lambda (var)
  271.                   (cons var (symbol-value var))
  272.                   ))
  273.                varlist))))
  274.       (setq vhdl-style-alist (cons default vhdl-style-alist))))
  275.  
  276. (defvar vhdl-mode-hook nil
  277.   "*Hook called by `vhdl-mode'.")
  278.  
  279. (defvar vhdl-mode-menu
  280.   '(["Comment Out Region"     comment-region (mark)]
  281.     ;; ["Indent Expression"      vhdl-indent-exp
  282.     ;; (memq (following-char) '(?\( ?\[ ?\{))]
  283.     ["Indent Line"            vhdl-indent-command t]
  284.     ["Backward Statement"     vhdl-beginning-of-statement t]
  285.     ;; ["Forward Statement"      vhdl-end-of-statement t]
  286.     )
  287.   "XEmacs 19 (formerly Lucid) menu for VHDL mode.")
  288.  
  289. ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  290. ;; NO USER DEFINABLE VARIABLES BEYOND THIS POINT
  291.  
  292.  
  293. ;; Emacs variant handling, and standard mode variables and functions:
  294.  
  295. (defconst vhdl-emacs-features
  296.   (let ((major (and (boundp 'emacs-major-version)
  297.             emacs-major-version))
  298.     (minor (and (boundp 'emacs-minor-version)
  299.             emacs-minor-version))
  300.     flavor)
  301.     ;; figure out version numbers if not already discovered
  302.     (and (or (not major) (not minor))
  303.      (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
  304.      (setq major (string-to-int (substring emacs-version
  305.                            (match-beginning 1)
  306.                            (match-end 1)))
  307.            minor (string-to-int (substring emacs-version
  308.                            (match-beginning 2)
  309.                            (match-end 2)))))
  310.     (if (not (and major minor))
  311.     (error "Cannot figure out the major and minor version numbers."))
  312.     ;; calculate the major version
  313.     (cond
  314.      ((= major 18)  (setq major 'v18))    ;Emacs 18
  315.      ((= major 4)   (setq major 'v18))    ;Epoch 4
  316.      ((= major 19)  (setq major 'v19    ;Emacs 19
  317.               flavor (cond
  318.                   ((string-match "Win-Emacs" emacs-version)
  319.                    'Win-Emacs)
  320.                   ((or (string-match "Lucid" emacs-version)
  321.                        (string-match "XEmacs" emacs-version))
  322.                    'XEmacs)
  323.                   (t
  324.                    'FSF))))
  325.      ((>= major 20) (setq major 'v20    ;Emacs 20 or later
  326.               flavor (if (string-match "XEmacs" emacs-version)
  327.                      'XEmacs
  328.                    'FSF)))
  329.      ;; I don't know
  330.      (t (error "Cannot recognize major version number: %s" major)))
  331.     ;; lets do some minimal sanity checking.
  332.     (if (and (or
  333.           ;; Emacs 18 is brain dead
  334.           (eq major 'v18)
  335.           ;; Lemacs before 19.6 had bugs
  336.           (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6))
  337.           ;; FSF 19 before 19.21 had bugs
  338.           (and (eq major 'v19) (eq flavor 'FSF) (< minor 21)))
  339.          (not vhdl-inhibit-startup-warnings-p))
  340.     (with-output-to-temp-buffer "*vhdl-mode warnings*"
  341.       (print (format
  342. "The version of Emacs that you are running, %s,
  343. has known bugs in its syntax.c parsing routines which will affect the
  344. performance of vhdl-mode. You should strongly consider upgrading to the
  345. latest available version.  vhdl-mode may continue to work, after a
  346. fashion, but strange indentation errors could be encountered."
  347.              emacs-version))))
  348.     (list major flavor))
  349.   "A list of features extant in the Emacs you are using.
  350. There are many flavors of Emacs out there, each with different
  351. features supporting those needed by vhdl-mode.  Here's the current
  352. supported list, along with the values for this variable:
  353.  
  354.  Emacs 18/Epoch 4:           (v18)
  355.  XEmacs (formerly Lucid) 19: (v19 XEmacs)
  356.  Win-Emacs 1.35:             (V19 Win-Emacs)
  357.  FSF Emacs 19:               (v19 FSF).")
  358.  
  359. (defvar vhdl-mode-abbrev-table nil
  360.   "Abbrev table in use in vhdl-mode buffers.")
  361. (define-abbrev-table 'vhdl-mode-abbrev-table ())
  362.  
  363. (defvar vhdl-mode-map ()
  364.   "Keymap used in vhdl-mode buffers.")
  365. (if vhdl-mode-map
  366.     ()
  367.   ;; TBD: should we even worry about naming this keymap. My vote: no,
  368.   ;; because FSF and XEmacs (formerly Lucid) do it differently.
  369.   (setq vhdl-mode-map (make-sparse-keymap))
  370.   ;; put standard keybindings into MAP
  371.   (define-key vhdl-mode-map "\M-a"    'vhdl-beginning-of-statement)
  372.   ;;(define-key vhdl-mode-map "\M-e"    'vhdl-end-of-statement)
  373.   (define-key vhdl-mode-map "\M-\C-f"   'vhdl-forward-sexp)
  374.   (define-key vhdl-mode-map "\M-\C-b"   'vhdl-backward-sexp)
  375.   (define-key vhdl-mode-map "\M-\C-u"    'vhdl-backward-up-list)
  376.   ;;(define-key vhdl-mode-map "\M-\C-d"    'vhdl-down-list)
  377.   (define-key vhdl-mode-map "\M-\C-a"    'vhdl-beginning-of-defun)
  378.   (define-key vhdl-mode-map "\M-\C-e"    'vhdl-end-of-defun)
  379.   (define-key vhdl-mode-map "\M-\C-h"    'vhdl-mark-defun)
  380.   (define-key vhdl-mode-map "\M-\C-q"    'vhdl-indent-sexp)
  381.   (define-key vhdl-mode-map "\t"        'vhdl-indent-command)
  382.   (define-key vhdl-mode-map "\177"      'backward-delete-char-untabify)
  383.   ;; these are new keybindings, with no counterpart to BOCM
  384.   (define-key vhdl-mode-map "\C-c\C-b"  'vhdl-submit-bug-report)
  385.   (define-key vhdl-mode-map "\C-c\C-c"  'comment-region)
  386.   (define-key vhdl-mode-map "\C-c\C-o"  'vhdl-set-offset)
  387.   (define-key vhdl-mode-map "\C-c\C-r"  'vhdl-regress-line)
  388.   (define-key vhdl-mode-map "\C-c\C-s"  'vhdl-show-syntactic-information)
  389.   (define-key vhdl-mode-map "\C-c\C-v"  'vhdl-version)
  390.   ;; in XEmacs (formerly Lucid) 19, we want the menu to popup when
  391.   ;; the 3rd button is hit.  In 19.10 and beyond this is done
  392.   ;; automatically if we put the menu on mode-popup-menu variable,
  393.   ;; see c-common-init. RMS decided that this feature should not be
  394.   ;; included for FSF's Emacs.
  395.   (if (and (boundp 'current-menubar)
  396.        (not (boundp 'mode-popup-menu)))
  397.       (define-key vhdl-mode-map 'button3 'vhdl-popup-menu))
  398.   )
  399.  
  400. (defvar vhdl-mode-syntax-table nil
  401.   "Syntax table used in vhdl-mode buffers.")
  402. (if vhdl-mode-syntax-table
  403.     ()
  404.   (setq vhdl-mode-syntax-table (make-syntax-table))
  405.   ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS!
  406.   (modify-syntax-entry ?\" "\""    vhdl-mode-syntax-table)
  407.   (modify-syntax-entry ?\$ "."     vhdl-mode-syntax-table)
  408.   (modify-syntax-entry ?\% "."     vhdl-mode-syntax-table)
  409.   (modify-syntax-entry ?\& "."     vhdl-mode-syntax-table)
  410.   (modify-syntax-entry ?\' "."     vhdl-mode-syntax-table)
  411.   (modify-syntax-entry ?\( "()"    vhdl-mode-syntax-table)
  412.   (modify-syntax-entry ?\) ")("    vhdl-mode-syntax-table)
  413.   (modify-syntax-entry ?\* "."     vhdl-mode-syntax-table)
  414.   (modify-syntax-entry ?\+ "."     vhdl-mode-syntax-table)
  415.   (modify-syntax-entry ?\. "."     vhdl-mode-syntax-table)
  416.   (modify-syntax-entry ?\/ "."     vhdl-mode-syntax-table)
  417.   (modify-syntax-entry ?\: "."     vhdl-mode-syntax-table)
  418.   (modify-syntax-entry ?\; "."     vhdl-mode-syntax-table)
  419.   (modify-syntax-entry ?\< "."     vhdl-mode-syntax-table)
  420.   (modify-syntax-entry ?\= "."     vhdl-mode-syntax-table)
  421.   (modify-syntax-entry ?\> "."     vhdl-mode-syntax-table)
  422.   (modify-syntax-entry ?\[ "(]"    vhdl-mode-syntax-table)
  423.   (modify-syntax-entry ?\\ "\\"    vhdl-mode-syntax-table)
  424.   (modify-syntax-entry ?\] ")["    vhdl-mode-syntax-table)
  425.   (modify-syntax-entry ?\{ "(}"    vhdl-mode-syntax-table)
  426.   (modify-syntax-entry ?\| "."     vhdl-mode-syntax-table)
  427.   (modify-syntax-entry ?\} "){"    vhdl-mode-syntax-table)
  428.   ;; add comment syntax
  429.   (modify-syntax-entry ?\- ". 12"  vhdl-mode-syntax-table)
  430.   (modify-syntax-entry ?\n ">"     vhdl-mode-syntax-table)
  431.   (modify-syntax-entry ?\^M ">"    vhdl-mode-syntax-table))
  432.  
  433. (defvar vhdl-syntactic-context nil
  434.   "Buffer local variable containing syntactic analysis list.")
  435. (make-variable-buffer-local 'vhdl-syntactic-context)
  436.  
  437. ;; Support for outline modes
  438.  
  439. (defconst vhdl-outline-regexp
  440.   (concat "\\(entity\\)\\|\\(package\\)\\|"
  441.       "\\( *procedure\\)\\|\\( *function\\)\\|"
  442.       "\\( *component\\)\\|\\(architecture\\)\\|"
  443.       "\\(package body\\)\\|\\( *[A-Za-z][A-Za-z0-9_]* : block\\)\\|"
  444.       "\\( *[A-Za-z][A-Za-z0-9_]* : process\\)\\|\\(configuration\\)"))
  445.  
  446. (defun vhdl-outline-level ()        ; was copied from c-outline-level
  447.   (save-excursion
  448.     (skip-chars-forward "\t ")
  449.     (current-column)))
  450.  
  451. ;; Support for font-lock
  452.  
  453. (defconst vhdl-font-lock-keywords-1
  454.   (purecopy
  455.    (list
  456.     ;; Highlight names of common constructs
  457.     (list
  458.      (concat
  459.       "^[ \t]*\\(entity\\|architecture\\|configuration\\|function\\|"
  460.       "procedure\\|component\\|package[ \t]+body\\|package\\|"
  461.       "end[ \t]+\\(block\\|process\\|case\\|generate\\|loop\\)\\)[ \t]+"
  462.       "\\(\\(\\w\\|\\s_\\)+\\)")
  463.      3 'font-lock-function-name-face)
  464.     
  465.     ;; Highlight labels of common constructs
  466.     (list
  467.      (concat
  468.       "^[ \t]*\\(\\(\\w\\|\\s_\\)+\\)[ \t]*:[ \t\n]*\\(block\\|process\\|"
  469.       "if\\|for\\|case\\|exit\\|loop\\|next\\|null\\|with\\|"
  470.       "\\(\\w\\|\\s_\\)+[ \t\n]+port[ \t]+map\\)\\>[^_]")
  471.      1 'font-lock-function-name-face)
  472.     
  473.     ;; Highlight OF labels
  474.     (list
  475.      (concat
  476.       "^[ \t]*\\(configuration\\|architecture\\|attribute\\)[ \t]+"
  477.       "\\(\\(\\w\\|\\s_\\)+\\)[ \t]+of[ \t]+\\(\\(\\w\\|\\s_\\)+\\)")
  478.      4 'font-lock-function-name-face)
  479.     
  480.     ;; Fontify library useage clauses.
  481.     (list
  482.      (concat
  483.       "[^\\s_]\\<\\(library\\|use\\)[ \t\n]+\\(entity[ \t\n]+\\)?"
  484.       "\\(\\(\\w\\|\\s_\\|[\.()]\\)+\\)")
  485.      3 'font-lock-function-name-face)
  486.     ))
  487.   "For consideration as a value of `vhdl-font-lock-keywords'.
  488. This does fairly subdued highlighting of function names.")
  489.  
  490. (defconst vhdl-font-lock-keywords-2
  491.   (purecopy
  492.    (append
  493.     vhdl-font-lock-keywords-1
  494.     (list
  495.      (list
  496.       (concat
  497.        "[^\\s_]\\<\\("
  498.        (mapconcat
  499.     'identity
  500.     '(
  501.       ;; the following is a list of all reserved words known in VHDL'93
  502.       "abs" "access" "after" "alias" "all" "and" "assert"
  503.       "architecture" "array" "attribute"
  504.       "begin" "block" "body" "buffer" "bus"
  505.       "case" "component" "configuration" "constant"
  506.       "disconnect" "downto"
  507.       "else" "elsif" "end" "entity" "exit"
  508.       "file" "for" "function"
  509.       "generate" "generic" "group" "guarded"
  510.       "if" "impure" "in" "inertial" "inout" "is"
  511.       "label" "library" "linkage" "literal" "loop" 
  512.       "map" "mod" 
  513.       "nand" "new" "next" "nor" "not" "null"
  514.       "of" "on" "open" "or" "others" "out"
  515.       "package" "port" "postponed" "procedure" "process" "pure"
  516.       "range" "record" "register" "reject" "rem" "report" "return"
  517.       "rol" "ror"
  518.       "select" "severity" "signal" "shared" "sla" "sll" "sra" "srl"
  519.       "subtype"
  520.       "then" "to" "transport" "type" 
  521.       "unaffected" "units" "until" "use"
  522.       "variable" "wait" "when" "while" "with" 
  523.       "xnor" "xor"
  524.       "note" "warning" "error" "failure"
  525.       ;; the following list contains predefined attributes
  526.       "base" "left" "right" "high" "low" "pos" "val" "succ"
  527.       "pred" "leftof" "rightof" "range" "reverse_range"
  528.       "length" "delayed" "stable" "quiet" "transaction"
  529.       "event" "active" "last_event" "last_active" "last_value"
  530.       "driving" "driving_value" "ascending" "value" "image"
  531.       "simple_name" "instance_name" "path_name"
  532.       "foreign"
  533.       ;; the following list contains standardized types
  534.       "boolean" "bit" "bit_vector" "character" "severity_level" "integer"
  535.       "real" "time" "natural" "positive" "string" "text" "line"
  536.       "unsigned" "signed"
  537.       "std_logic" "std_logic_vector"
  538.       "std_ulogic" "std_ulogic_vector"
  539.       )
  540.     "\\|")
  541.        "\\)\\>[^\\s_]")
  542.       1 'font-lock-keyword-face)
  543.      )))
  544.   "For consideration as a value of `vhdl-font-lock-keywords'.
  545. This does a lot more highlighting.")
  546.  
  547. ;; The keywords in the preceding lists assume case-insensitivity.
  548. (put 'vhdl-mode 'font-lock-keywords-case-fold-search t)
  549.  
  550. (defvar vhdl-font-lock-keywords vhdl-font-lock-keywords-1
  551.   "Additional expressions to highlight in VHDL mode.")
  552.  
  553. ;; This should eventually be subsumed into the respective functions in
  554. ;; the source for "font-lock.el".
  555. (if (featurep 'advice)
  556.     (progn
  557.       (defadvice font-lock-use-default-minimal-decoration
  558.     (before vhdl-mode activate)
  559.     "Do it for VHDL mode too."
  560.     (setq vhdl-font-lock-keywords vhdl-font-lock-keywords-1))
  561.       
  562.       (defadvice font-lock-use-default-maximal-decoration
  563.     (before vhdl-mode activate)
  564.     "Do it for VHDL mode too."
  565.     (setq vhdl-font-lock-keywords vhdl-font-lock-keywords-2))
  566.       ))
  567.  
  568.  
  569. ;; Main entry point for VHDL mode:
  570.  
  571. ;;;###autoload
  572. (defun vhdl-mode ()
  573.   "Major mode for editing VHDL code.
  574. vhdl-mode $Revision: 2.74 $
  575. To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a
  576. vhdl-mode buffer.  This automatically sets up a mail buffer with version
  577. information already added.  You just need to add a description of the
  578. problem, including a reproducable test case and send the message.
  579.  
  580. Note that the details of configuring vhdl-mode will soon be moved to the
  581. accompanying texinfo manual.  Until then, please read the README file
  582. that came with the vhdl-mode distribution.
  583.  
  584. The hook variable `vhdl-mode-hook' is run with no args, if that value is
  585. bound and has a non-nil value.
  586.  
  587. Key bindings:
  588. \\{vhdl-mode-map}"
  589.   (interactive)
  590.   (kill-all-local-variables)
  591.   (set-syntax-table vhdl-mode-syntax-table)
  592.   (setq major-mode 'vhdl-mode
  593.     mode-name "VHDL"
  594.     local-abbrev-table vhdl-mode-abbrev-table)
  595.   (use-local-map vhdl-mode-map)
  596.   ;; set local variable values
  597.   (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter))
  598.   (set (make-local-variable 'paragraph-separate) paragraph-start)
  599.   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
  600.   (set (make-local-variable 'require-final-newline) t)
  601.   (set (make-local-variable 'parse-sexp-ignore-comments) t)
  602.   (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
  603.   (set (make-local-variable 'comment-start) "-- ")
  604.   (set (make-local-variable 'comment-end) "")
  605.   (set (make-local-variable 'comment-column) 32)
  606.   (set (make-local-variable 'comment-start-skip) "--+ *")
  607.   (set (make-local-variable 'outline-regexp) vhdl-outline-regexp)
  608.   (set (make-local-variable 'outline-level) 'vhdl-outline-level)
  609.  
  610.   ;; setup the comment indent variable in a Emacs version portable way
  611.   ;; ignore any byte compiler warnings you might get here
  612.   (if (boundp 'comment-indent-function)
  613.       (progn
  614.        (make-local-variable 'comment-indent-function)
  615.        (setq comment-indent-function 'vhdl-comment-indent))
  616.     (make-local-variable 'comment-indent-hook)
  617.     (setq comment-indent-hook 'vhdl-comment-indent))
  618.   ;; put VHDL menu into menubar and on popup menu for XEmacs (formerly
  619.   ;; Lucid) 19. I think this happens automatically for FSF Emacs 19.
  620.   (if (and (boundp 'current-menubar)
  621.        current-menubar
  622.        (not (assoc mode-name current-menubar)))
  623.       (progn
  624.     (set-buffer-menubar (copy-sequence current-menubar))
  625.     (add-menu nil mode-name vhdl-mode-menu)))
  626.   (if (boundp 'mode-popup-menu)
  627.       (setq mode-popup-menu
  628.         (cons (concat mode-name " Mode Commands") vhdl-mode-menu)))
  629.   (run-hooks 'vhdl-mode-hook))
  630.  
  631. ;; menus for XEmacs (formerly Lucid)
  632.  
  633. (defun vhdl-popup-menu (e)
  634.   "Pops up the VHDL menu."
  635.   (interactive "@e")
  636.   (popup-menu (cons (concat mode-name " Mode Commands") vhdl-mode-menu))
  637.   (vhdl-keep-region-active))
  638.  
  639. ;; active regions
  640.  
  641. (defun vhdl-keep-region-active ()
  642.   ;; do whatever is necessary to keep the region active in XEmacs
  643.   ;; (formerly Lucid). ignore byte-compiler warnings you might see
  644.   (and (boundp 'zmacs-region-stays)
  645.        (setq zmacs-region-stays t)))
  646.  
  647. ;; constant regular expressions for looking at various constructs
  648.  
  649. (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+"
  650.   "Regexp describing a VHDL symbol.
  651. We cannot use just `word' syntax class since `_' cannot be in word
  652. class.  Putting underscore in word class breaks forward word movement
  653. behavior that users are familiar with.")
  654.  
  655. (defconst vhdl-case-alternative-key "when[( \t\n][^;=>]+=>"
  656.   "Regexp describing a case statement alternative key.")
  657.  
  658. (defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is"
  659.   "Regexp describing a case statement header key.")
  660.  
  661. (defconst vhdl-label-key
  662.   (concat vhdl-symbol-key "\\s-*:")
  663.   "Regexp describing a VHDL label.")
  664.  
  665.  
  666. ;; Macro definitions:
  667.  
  668. (defmacro vhdl-point (position)
  669.   ;; Returns the value of point at certain commonly referenced POSITIONs.
  670.   ;; POSITION can be one of the following symbols:
  671.   ;; 
  672.   ;; bol  -- beginning of line
  673.   ;; eol  -- end of line
  674.   ;; bod  -- beginning of defun
  675.   ;; boi  -- back to indentation
  676.   ;; eoi  -- last whitespace on line
  677.   ;; ionl -- indentation of next line
  678.   ;; iopl -- indentation of previous line
  679.   ;; bonl -- beginning of next line
  680.   ;; bopl -- beginning of previous line
  681.   ;; 
  682.   ;; This function does not modify point or mark.
  683.   (or (and (eq 'quote (car-safe position))
  684.        (null (cdr (cdr position))))
  685.       (error "bad buffer position requested: %s" position))
  686.   (setq position (nth 1 position))
  687.   (` (let ((here (point)))
  688.        (,@ (cond
  689.         ((eq position 'bol)  '((beginning-of-line)))
  690.         ((eq position 'eol)  '((end-of-line)))
  691.         ((eq position 'bod)  '((save-match-data
  692.                      (vhdl-beginning-of-defun))))
  693.         ((eq position 'boi)  '((back-to-indentation)))
  694.         ((eq position 'eoi)  '((end-of-line)(skip-chars-backward " \t")))
  695.         ((eq position 'bonl) '((forward-line 1)))
  696.         ((eq position 'bopl) '((forward-line -1)))
  697.         ((eq position 'iopl)
  698.          '((forward-line -1)
  699.            (back-to-indentation)))
  700.         ((eq position 'ionl)
  701.          '((forward-line 1)
  702.            (back-to-indentation)))
  703.         (t (error "unknown buffer position requested: %s" position))
  704.         ))
  705.        (prog1
  706.        (point)
  707.      (goto-char here))
  708.        ;; workaround for an Emacs18 bug -- blech! Well, at least it
  709.        ;; doesn't hurt for v19
  710.        (,@ nil)
  711.        )))
  712.  
  713. (defmacro vhdl-safe (&rest body)
  714.   ;; safely execute BODY, return nil if an error occurred
  715.   (` (condition-case nil
  716.      (progn (,@ body))
  717.        (error nil))))
  718.  
  719. (defmacro vhdl-add-syntax (symbol &optional relpos)
  720.   ;; a simple macro to append the syntax in symbol to the syntax list.
  721.   ;; try to increase performance by using this macro
  722.   (` (setq vhdl-syntactic-context
  723.        (cons (cons (, symbol) (, relpos)) vhdl-syntactic-context))))
  724.  
  725. (defmacro vhdl-has-syntax (symbol)
  726.   ;; a simple macro to return check the syntax list.
  727.   ;; try to increase performance by using this macro
  728.   (` (assoc (, symbol) vhdl-syntactic-context)))
  729.  
  730.  
  731. ;; Syntactic element offset manipulation:
  732.  
  733. (defun vhdl-read-offset (langelem)
  734.   ;; read new offset value for LANGELEM from minibuffer. return a
  735.   ;; legal value only
  736.   (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist))))
  737.     (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
  738.     (prompt "Offset: ")
  739.     offset input interned)
  740.     (while (not offset)
  741.       (setq input (read-string prompt oldoff)
  742.         offset (cond ((string-equal "+" input) '+)
  743.              ((string-equal "-" input) '-)
  744.              ((string-equal "++" input) '++)
  745.              ((string-equal "--" input) '--)
  746.              ((string-match "^-?[0-9]+$" input)
  747.               (string-to-int input))
  748.              ((fboundp (setq interned (intern input)))
  749.               interned)
  750.              ((boundp interned) interned)
  751.              ;; error, but don't signal one, keep trying
  752.              ;; to read an input value
  753.              (t (ding)
  754.                 (setq prompt errmsg)
  755.                 nil))))
  756.     offset))
  757.  
  758. (defun vhdl-set-offset (symbol offset &optional add-p)
  759.   "Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
  760. SYMBOL is the syntactic element symbol to change and OFFSET is the new
  761. offset for that syntactic element.  Optional ADD says to add SYMBOL to
  762. `vhdl-offsets-alist' if it doesn't already appear there."
  763.   (interactive
  764.    (let* ((langelem
  765.        (intern (completing-read
  766.             (concat "Syntactic symbol to change"
  767.                 (if current-prefix-arg " or add" "")
  768.                 ": ")
  769.             (mapcar
  770.              (function
  771.               (lambda (langelem)
  772.             (cons (format "%s" (car langelem)) nil)))
  773.              vhdl-offsets-alist)
  774.             nil (not current-prefix-arg)
  775.             ;; initial contents tries to be the last element
  776.             ;; on the syntactic analysis list for the current
  777.             ;; line
  778.             (let* ((syntax (vhdl-get-syntactic-context))
  779.                (len (length syntax))
  780.                (ic (format "%s" (car (nth (1- len) syntax)))))
  781.               (if (or (memq 'v19 vhdl-emacs-features)
  782.                   (memq 'v20 vhdl-emacs-features))
  783.               (cons ic 0)
  784.             ic))
  785.             )))
  786.       (offset (vhdl-read-offset langelem)))
  787.      (list langelem offset current-prefix-arg)))
  788.   ;; sanity check offset
  789.   (or (eq offset '+)
  790.       (eq offset '-)
  791.       (eq offset '++)
  792.       (eq offset '--)
  793.       (integerp offset)
  794.       (fboundp offset)
  795.       (boundp offset)
  796.       (error "Offset must be int, func, var, or one of +, -, ++, --: %s"
  797.          offset))
  798.   (let ((entry (assq symbol vhdl-offsets-alist)))
  799.     (if entry
  800.     (setcdr entry offset)
  801.       (if add-p
  802.       (setq vhdl-offsets-alist (cons (cons symbol offset) vhdl-offsets-alist))
  803.     (error "%s is not a valid syntactic symbol." symbol))))
  804.   (vhdl-keep-region-active))
  805.  
  806. (defun vhdl-set-style (style &optional local)
  807.   "Set vhdl-mode variables to use one of several different indentation styles.
  808. STYLE is a string representing the desired style and optional LOCAL is
  809. a flag which, if non-nil, means to make the style variables being
  810. changed buffer local, instead of the default, which is to set the
  811. global variables.  Interactively, the flag comes from the prefix
  812. argument.  The styles are chosen from the `vhdl-style-alist' variable."
  813.   (interactive (list (completing-read "Use which VHDL indentation style? "
  814.                                       vhdl-style-alist nil t)
  815.              current-prefix-arg))
  816.   (let ((vars (cdr (assoc style vhdl-style-alist))))
  817.     (or vars
  818.     (error "Invalid VHDL indentation style `%s'" style))
  819.     ;; set all the variables
  820.     (mapcar
  821.      (function
  822.       (lambda (varentry)
  823.     (let ((var (car varentry))
  824.           (val (cdr varentry)))
  825.       (and local
  826.            (make-local-variable var))
  827.       ;; special case for vhdl-offsets-alist
  828.       (if (not (eq var 'vhdl-offsets-alist))
  829.           (set var val)
  830.         ;; reset vhdl-offsets-alist to the default value first
  831.         (setq vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default))
  832.         ;; now set the langelems that are different
  833.         (mapcar
  834.          (function
  835.           (lambda (langentry)
  836.         (let ((langelem (car langentry))
  837.               (offset (cdr langentry)))
  838.           (vhdl-set-offset langelem offset)
  839.           )))
  840.          val))
  841.       )))
  842.      vars))
  843.   (vhdl-keep-region-active))
  844.  
  845. (defun vhdl-add-style (style descrip &optional set-p)
  846.   "Adds a style to `vhdl-style-alist', or updates an existing one.
  847. STYLE is a string identifying the style to add or update.  DESCRIP is
  848. an association list describing the style and must be of the form:
  849.  
  850.   ((VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
  851.  
  852. See the variable `vhdl-style-alist' for the semantics of VARIABLE and
  853. VALUE.  This function also sets the current style to STYLE using
  854. `vhdl-set-style' if the optional SET-P flag is non-nil."
  855.   (interactive
  856.    (let ((stylename (completing-read "Style to add: " vhdl-style-alist))
  857.      (description (eval-minibuffer "Style description: ")))
  858.      (list stylename description
  859.        (y-or-n-p "Set the style too? "))))
  860.   (setq style (downcase style))
  861.   (let ((s (assoc style vhdl-style-alist)))
  862.     (if s
  863.     (setcdr s (copy-alist descrip))    ; replace
  864.       (setq vhdl-style-alist (cons (cons style descrip) vhdl-style-alist))))
  865.   (and set-p (vhdl-set-style style)))
  866.  
  867. (defun vhdl-get-offset (langelem)
  868.   ;; Get offset from LANGELEM which is a cons cell of the form:
  869.   ;; (SYMBOL . RELPOS).  The symbol is matched against
  870.   ;; vhdl-offsets-alist and the offset found there is either returned,
  871.   ;; or added to the indentation at RELPOS.  If RELPOS is nil, then
  872.   ;; the offset is simply returned.
  873.   (let* ((symbol (car langelem))
  874.      (relpos (cdr langelem))
  875.      (match  (assq symbol vhdl-offsets-alist))
  876.      (offset (cdr-safe match)))
  877.     ;; offset can be a number, a function, a variable, or one of the
  878.     ;; symbols + or -
  879.     (cond
  880.      ((not match)
  881.       (if vhdl-strict-syntax-p
  882.       (error "don't know how to indent a %s" symbol)
  883.     (setq offset 0
  884.           relpos 0)))
  885.      ((eq offset '+)  (setq offset vhdl-basic-offset))
  886.      ((eq offset '-)  (setq offset (- vhdl-basic-offset)))
  887.      ((eq offset '++) (setq offset (* 2 vhdl-basic-offset)))
  888.      ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset))))
  889.      ((and (not (numberp offset))
  890.        (fboundp offset))
  891.       (setq offset (funcall offset langelem)))
  892.      ((not (numberp offset))
  893.       (setq offset (eval offset)))
  894.      )
  895.     (+ (if (and relpos
  896.         (< relpos (vhdl-point 'bol)))
  897.        (save-excursion
  898.          (goto-char relpos)
  899.          (current-column))
  900.      0)
  901.        offset)))
  902.  
  903.  
  904. ;; Syntactic support functions:
  905.  
  906. ;; Returns `comment' if in a comment, `string' if in a string literal,
  907. ;; or nil if not in a literal at all.  Optional LIM is used as the
  908. ;; backward limit of the search.  If omitted, or nil, (point-min) is
  909. ;; used.
  910.  
  911. (defun vhdl-in-literal (&optional lim)
  912.   ;; Determine if point is in a VHDL literal.
  913.   (save-excursion
  914.     (let* ((lim (or lim (point-min)))
  915.        (state (parse-partial-sexp lim (point))))
  916.       (cond
  917.        ((nth 3 state) 'string)
  918.        ((nth 4 state) 'comment)
  919.        (t nil)))
  920.     ))
  921.  
  922. ;; This is the best we can do in Win-Emacs.
  923. (defun vhdl-win-il (&optional lim)
  924.   ;; Determine if point is in a VHDL literal
  925.   (save-excursion
  926.     (let* ((here (point))
  927.        (state nil)
  928.        (match nil)
  929.        (lim  (or lim (vhdl-point 'bod))))
  930.       (goto-char lim )
  931.       (while (< (point) here)
  932.     (setq match
  933.           (and (re-search-forward "--\\|[\"']"
  934.                       here 'move)
  935.            (buffer-substring (match-beginning 0) (match-end 0))))
  936.     (setq state
  937.           (cond
  938.            ;; no match
  939.            ((null match) nil)
  940.            ;; looking at the opening of a VHDL style comment
  941.            ((string= "--" match)
  942.         (if (<= here (progn (end-of-line) (point))) 'comment))
  943.            ;; looking at the opening of a double quote string
  944.            ((string= "\"" match)
  945.         (if (not (save-restriction
  946.                ;; this seems to be necessary since the
  947.                ;; re-search-forward will not work without it
  948.                (narrow-to-region (point) here)
  949.                (re-search-forward
  950.                 ;; this regexp matches a double quote
  951.                 ;; which is preceded by an even number
  952.                 ;; of backslashes, including zero
  953.                 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move)))
  954.             'string))
  955.            ;; looking at the opening of a single quote string
  956.            ((string= "'" match)
  957.         (if (not (save-restriction
  958.                ;; see comments from above
  959.                (narrow-to-region (point) here)
  960.                (re-search-forward
  961.                 ;; this matches a single quote which is
  962.                 ;; preceded by zero or two backslashes.
  963.                 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'"
  964.                 here 'move)))
  965.             'string))
  966.            (t nil)))
  967.     ) ; end-while
  968.       state)))
  969.  
  970. (and (memq 'Win-Emacs vhdl-emacs-features)
  971.      (fset 'vhdl-in-literal 'vhdl-win-il))
  972.  
  973. ;; Skipping of "syntactic whitespace".  Syntactic whitespace is
  974. ;; defined as lexical whitespace or comments.  Search no farther back
  975. ;; or forward than optional LIM.  If LIM is omitted, (point-min) is
  976. ;; used for backward skipping, (point-max) is used for forward
  977. ;; skipping.
  978.  
  979. (defun vhdl-forward-syntactic-ws (&optional lim)
  980.   ;; Forward skip of syntactic whitespace.
  981.   (save-restriction
  982.     (let* ((lim (or lim (point-max)))
  983.        (here lim)
  984.        (hugenum (point-max)))
  985.       (narrow-to-region lim (point))
  986.       (while (/= here (point))
  987.     (setq here (point))
  988.     (forward-comment hugenum))
  989.       )))
  990.  
  991. ;; This is the best we can do in Win-Emacs.
  992. (defun vhdl-win-fsws (&optional lim)
  993.   ;; Forward skip syntactic whitespace for Win-Emacs.
  994.   (let ((lim (or lim (point-max)))
  995.     stop)
  996.     (while (not stop)
  997.       (skip-chars-forward " \t\n\r\f" lim)
  998.       (cond
  999.        ;; vhdl comment
  1000.        ((looking-at "--") (end-of-line))
  1001.        ;; none of the above
  1002.        (t (setq stop t))
  1003.        ))))
  1004.  
  1005. (and (memq 'Win-Emacs vhdl-emacs-features)
  1006.      (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
  1007.  
  1008. (defun vhdl-backward-syntactic-ws (&optional lim)
  1009.   ;; Backward skip over syntactic whitespace.
  1010.   (save-restriction
  1011.     (let* ((lim (or lim (point-min)))
  1012.        (here lim)
  1013.        (hugenum (- (point-max))))
  1014.       (if (< lim (point))
  1015.       (progn
  1016.         (narrow-to-region lim (point))
  1017.         (while (/= here (point))
  1018.           (setq here (point))
  1019.           (forward-comment hugenum)
  1020.           )))
  1021.       )))
  1022.  
  1023. ;; This is the best we can do in Win-Emacs.
  1024. (defun vhdl-win-bsws (&optional lim)
  1025.   ;; Backward skip syntactic whitespace for Win-Emacs.
  1026.   (let ((lim (or lim (vhdl-point 'bod)))
  1027.     stop)
  1028.     (while (not stop)
  1029.       (skip-chars-backward " \t\n\r\f" lim)
  1030.       (cond
  1031.        ;; vhdl comment
  1032.        ((eq (vhdl-in-literal lim) 'comment)
  1033.     (skip-chars-backward "^-" lim)
  1034.     (skip-chars-backward "-" lim)
  1035.     (while (not (or (and (= (following-char) ?-)
  1036.                  (= (char-after (1+ (point))) ?-))
  1037.             (<= (point) lim)))
  1038.       (skip-chars-backward "^-" lim)
  1039.       (skip-chars-backward "-" lim)))
  1040.        ;; none of the above
  1041.        (t (setq stop t))
  1042.        ))))
  1043.  
  1044. (and (memq 'Win-Emacs vhdl-emacs-features)
  1045.     (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
  1046.  
  1047. ;; Functions to help finding the correct indentation column:
  1048.  
  1049. (defun vhdl-first-word (point)
  1050.   "If the keyword at POINT is at boi, then return (current-column) at
  1051. that point, else nil."
  1052.   (save-excursion
  1053.     (and (goto-char point)
  1054.      (eq (point) (vhdl-point 'boi))
  1055.      (current-column))))
  1056.  
  1057. (defun vhdl-last-word (point)
  1058.   "If the keyword at POINT is at eoi, then return (current-column) at
  1059. that point, else nil."
  1060.   (save-excursion
  1061.     (and (goto-char point)
  1062.      (save-excursion (or (eq (progn (forward-sexp) (point))
  1063.                  (vhdl-point 'eoi))
  1064.                  (looking-at "\\s-*\\(--\\)?")))
  1065.      (current-column))))
  1066.  
  1067.  
  1068. ;; Core syntactic evaluation functions:
  1069.  
  1070. (defconst vhdl-libunit-re
  1071.   "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]")
  1072.  
  1073. (defun vhdl-libunit-p ()
  1074.   (and
  1075.    (save-excursion
  1076.      (forward-sexp)
  1077.      (skip-chars-forward " \t\n")
  1078.      (not (looking-at "is\\b[^_]")))
  1079.    (save-excursion
  1080.      (backward-sexp)
  1081.      (not (looking-at "use\\b[^_]")))))
  1082.  
  1083. (defconst vhdl-defun-re
  1084.   "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedure\\|function\\)\\b[^_]")
  1085.  
  1086. (defun vhdl-defun-p ()
  1087.   (save-excursion
  1088.     (if (looking-at "block\\|process")
  1089.     ;; "block", "process":
  1090.     (save-excursion
  1091.       (backward-sexp)
  1092.       (not (looking-at "end\\s-+\\w")))
  1093.       ;; "architecture", "configuration", "entity",
  1094.       ;; "package", "procedure", "function":
  1095.       t)))
  1096.   
  1097. (defun vhdl-corresponding-defun ()
  1098.   "If the word at the current position corresponds to a \"defun\"
  1099. keyword, then return a string that can be used to find the
  1100. corresponding \"begin\" keyword, else return nil."
  1101.   (save-excursion
  1102.     (and (looking-at vhdl-defun-re)
  1103.      (vhdl-defun-p)
  1104.      (if (looking-at "block\\|process")
  1105.          ;; "block", "process":
  1106.          (buffer-substring (match-beginning 0) (match-end 0))
  1107.        ;; "architecture", "configuration", "entity", "package",
  1108.        ;; "procedure", "function":
  1109.        "is"))))
  1110.  
  1111. (defconst vhdl-begin-fwd-re
  1112.   "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|units\\|record\\|for\\)\\b\\([^_]\\|\\'\\)"
  1113.   "A regular expression for searching forward that matches all known
  1114. \"begin\" keywords.")
  1115.  
  1116. (defconst vhdl-begin-bwd-re
  1117.   "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|units\\|record\\|for\\)\\b"
  1118.   "A regular expression for searching backward that matches all known
  1119. \"begin\" keywords.")
  1120.  
  1121. (defun vhdl-begin-p (&optional lim)
  1122.   "Return t if we are looking at a real \"begin\" keyword.
  1123. Assumes that the caller will make sure that we are looking at
  1124. vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
  1125. the middle of an identifier that just happens to contain a \"begin\"
  1126. keyword."
  1127.   (cond
  1128.    ;; "[architecture|case|configuration|entity|package|
  1129.    ;;   procedure|function] ... is":
  1130.    ((and (looking-at "i")
  1131.      (save-excursion
  1132.        ;; Skip backward over first sexp (needed to skip over a
  1133.        ;; procedure interface list, and is harmless in other
  1134.        ;; situations).  Note that we need "return" in the
  1135.        ;; following search list so that we don't run into
  1136.        ;; semicolons in the function interface list.
  1137.        (backward-sexp)
  1138.        (let (foundp)
  1139.          (while (and (not foundp)
  1140.              (re-search-backward
  1141.               ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|block\\)\\b[^_]"
  1142.               lim 'move))
  1143.            (if (or (= (preceding-char) ?_)
  1144.                (vhdl-in-literal lim))
  1145.            (backward-char)
  1146.          (setq foundp t))))
  1147.        (and (/= (following-char) ?\;)
  1148.         (not (looking-at "is\\|begin\\|process\\|block")))))
  1149.     t)
  1150.    ;; "begin", "then":
  1151.    ((looking-at "be\\|t")
  1152.     t)
  1153.    ;; "else":
  1154.    ((and (looking-at "e")
  1155.      ;; make sure that the "else" isn't inside a
  1156.      ;; conditional signal assignment.
  1157.      (save-excursion
  1158.        (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
  1159.        (or (eq (following-char) ?\;)
  1160.            (eq (point) lim))))
  1161.     t)
  1162.    ;; "block", "component", "generate", "loop", "process",
  1163.    ;; "units", "record":
  1164.    ((and (looking-at "bl\\|[cglpur]")
  1165.      (save-excursion
  1166.        (backward-sexp)
  1167.        (not (looking-at "end\\s-+\\w"))))
  1168.     t)
  1169.    ;; "for" (inside configuration declaration):
  1170.    ((and (looking-at "f")
  1171.      (save-excursion
  1172.        (backward-sexp)
  1173.        (not (looking-at "end\\s-+\\w")))
  1174.      (vhdl-has-syntax 'configuration))
  1175.     t)
  1176.    ))
  1177.   
  1178. (defun vhdl-corresponding-mid (&optional lim)
  1179.   (cond
  1180.    ((looking-at "is\\|block\\|process")
  1181.     "begin")
  1182.    ((looking-at "then")
  1183.     "<else>")
  1184.    (t
  1185.     "end")))
  1186.  
  1187. (defun vhdl-corresponding-end (&optional lim)
  1188.   "If the word at the current position corresponds to a \"begin\"
  1189. keyword, then return a vector containing enough information to find
  1190. the corresponding \"end\" keyword, else return nil.  The keyword to
  1191. search forward for is aref 0.  The column in which the keyword must
  1192. appear is aref 1 or nil if any column is suitable.
  1193. Assumes that the caller will make sure that we are not in the middle
  1194. of an identifier that just happens to contain a \"begin\" keyword."
  1195.   (save-excursion
  1196.     (and (looking-at vhdl-begin-fwd-re)
  1197.      (/= (preceding-char) ?_)
  1198.      (not (vhdl-in-literal lim))
  1199.      (vhdl-begin-p lim)
  1200.      (cond
  1201.       ;; "is", "generate", "loop":
  1202.       ((looking-at "[igl]")
  1203.        (vector "end"
  1204.            (and (vhdl-last-word (point))
  1205.             (or (vhdl-first-word (point))
  1206.                 (save-excursion
  1207.                   (vhdl-beginning-of-statement-1 lim)
  1208.                   (vhdl-backward-skip-label lim)
  1209.                   (vhdl-first-word (point)))))))
  1210.       ;; "begin", "else", "for":
  1211.       ((looking-at "be\\|[ef]")
  1212.        (vector "end"
  1213.            (and (vhdl-last-word (point))
  1214.             (or (vhdl-first-word (point))
  1215.                 (save-excursion
  1216.                   (vhdl-beginning-of-statement-1 lim)
  1217.                   (vhdl-backward-skip-label lim)
  1218.                   (vhdl-first-word (point)))))))
  1219.       ;; "component", "units", "record":
  1220.       ((looking-at "[cur]")
  1221.        ;; The first end found will close the block
  1222.        (vector "end" nil))
  1223.       ;; "block", "process":
  1224.       ((looking-at "bl\\|p")
  1225.        (vector "end"
  1226.            (or (vhdl-first-word (point))
  1227.                (save-excursion
  1228.              (vhdl-beginning-of-statement-1 lim)
  1229.              (vhdl-backward-skip-label lim)
  1230.              (vhdl-first-word (point))))))
  1231.       ;; "then":
  1232.       ((looking-at "t")
  1233.        (vector "elsif\\|else\\|end"
  1234.            (and (vhdl-last-word (point))
  1235.             (or (vhdl-first-word (point))
  1236.                 (save-excursion
  1237.                   (vhdl-beginning-of-statement-1 lim)
  1238.                   (vhdl-backward-skip-label lim)
  1239.                   (vhdl-first-word (point)))))))
  1240.       ))))
  1241.  
  1242. (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)")
  1243.  
  1244. (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b")
  1245.  
  1246. (defun vhdl-end-p (&optional lim)
  1247.   "Return t if we are looking at a real \"end\" keyword.
  1248. Assumes that the caller will make sure that we are looking at
  1249. vhdl-end-fwd-re, and are not inside a literal, and that we are not in
  1250. the middle of an identifier that just happens to contain an \"end\"
  1251. keyword."
  1252.   (or (not (looking-at "else"))
  1253.       ;; make sure that the "else" isn't inside a conditional signal
  1254.       ;; assignment.
  1255.       (save-excursion
  1256.     (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
  1257.     (or (eq (following-char) ?\;)
  1258.         (eq (point) lim)))))
  1259.  
  1260. (defun vhdl-corresponding-begin (&optional lim)
  1261.   "If the word at the current position corresponds to an \"end\"
  1262. keyword, then return a vector containing enough information to find
  1263. the corresponding \"begin\" keyword, else return nil.  The keyword to
  1264. search backward for is aref 0.  The column in which the keyword must
  1265. appear is aref 1 or nil if any column is suitable.  The supplementary
  1266. keyword to search forward for is aref 2 or nil if this is not
  1267. required.  If aref 3 is t, then the \"begin\" keyword may be found in
  1268. the middle of a statement.
  1269. Assumes that the caller will make sure that we are not in the middle
  1270. of an identifier that just happens to contain an \"end\" keyword."
  1271.   (save-excursion
  1272.     (let (pos)
  1273.       (if (and (looking-at vhdl-end-fwd-re)
  1274.            (not (vhdl-in-literal lim))
  1275.            (vhdl-end-p lim))
  1276.       (if (looking-at "el")
  1277.           ;; "else", "elsif":
  1278.           (vector "if\\|elsif" (vhdl-first-word (point)) "then" nil)
  1279.         ;; "end ...":
  1280.         (setq pos (point))
  1281.         (forward-sexp)
  1282.         (skip-chars-forward " \t\n")
  1283.         (cond
  1284.          ;; "end if":
  1285.          ((looking-at "if\\b[^_]")
  1286.           (vector "else\\|elsif\\|if"
  1287.               (vhdl-first-word pos)
  1288.               "else\\|then" nil))
  1289.          ;; "end component":
  1290.          ((looking-at "component\\b[^_]")
  1291.           (vector (buffer-substring (match-beginning 1)
  1292.                     (match-end 1))
  1293.               (vhdl-first-word pos)
  1294.               nil nil))
  1295.          ;; "end units", "end record":
  1296.          ((looking-at "\\(units\\|record\\)\\b[^_]")
  1297.           (vector (buffer-substring (match-beginning 1)
  1298.                     (match-end 1))
  1299.               (vhdl-first-word pos)
  1300.               nil t))
  1301.          ;; "end block", "end process":
  1302.          ((looking-at "\\(block\\|process\\)\\b[^_]")
  1303.           (vector "begin" (vhdl-first-word pos) nil nil))
  1304.          ;; "end case":
  1305.          ((looking-at "case\\b[^_]")
  1306.           (vector "case" (vhdl-first-word pos) "is" nil))
  1307.          ;; "end generate":
  1308.          ((looking-at "generate\\b[^_]")
  1309.           (vector "generate\\|for\\|if"
  1310.               (vhdl-first-word pos)
  1311.               "generate" nil))
  1312.          ;; "end loop":
  1313.          ((looking-at "loop\\b[^_]")
  1314.           (vector "loop\\|while\\|for"
  1315.               (vhdl-first-word pos)
  1316.               "loop" nil))
  1317.          ;; "end for" (inside configuration declaration):
  1318.          ((looking-at "for\\b[^_]")
  1319.           (vector "for" (vhdl-first-word pos) nil nil))
  1320.          ;; "end [id]":
  1321.          (t
  1322.           (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function"
  1323.               (vhdl-first-word pos)
  1324.               ;; return an alist of (statement . keyword) mappings
  1325.               '(
  1326.             ;; "begin ... end [id]":
  1327.             ("begin"          . nil)
  1328.             ;; "architecture ... is ... begin ... end [id]":
  1329.             ("architecture"   . "is")
  1330.             ;; "configuration ... is ... end [id]":
  1331.             ("configuration"  . "is")
  1332.             ;; "entity ... is ... end [id]":
  1333.             ("entity"         . "is")
  1334.             ;; "package ... is ... end [id]":
  1335.             ("package"        . "is")
  1336.             ;; "procedure ... is ... begin ... end [id]":
  1337.             ("procedure"      . "is")
  1338.             ;; "function ... is ... begin ... end [id]":
  1339.             ("function"       . "is")
  1340.             )
  1341.               nil))
  1342.          ))) ; "end ..."
  1343.       )))
  1344.  
  1345. (defconst vhdl-leader-re
  1346.   "\\b\\(block\\|component\\|process\\|for\\)\\b[^_]")
  1347.  
  1348. (defun vhdl-end-of-leader ()
  1349.   (save-excursion
  1350.     (cond ((looking-at "block\\|process")
  1351.        (if (save-excursion
  1352.          (forward-sexp)
  1353.          (skip-chars-forward " \t\n")
  1354.          (= (following-char) ?\())
  1355.            (forward-sexp 2)
  1356.          (forward-sexp))
  1357.        (point))
  1358.       ((looking-at "component")
  1359.        (forward-sexp 2)
  1360.        (point))
  1361.       ((looking-at "for")
  1362.        (forward-sexp 2)
  1363.        (skip-chars-forward " \t\n")
  1364.        (while (looking-at "[,:(]")
  1365.          (forward-sexp)
  1366.          (skip-chars-forward " \t\n"))
  1367.        (point))
  1368.       (t nil)
  1369.       )))
  1370.  
  1371. (defconst vhdl-trailer-re
  1372.   "\\b\\(is\\|then\\|generate\\|loop\\)\\b[^_]")
  1373.  
  1374. (defconst vhdl-statement-fwd-re
  1375.   "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)"
  1376.   "A regular expression for searching forward that matches all known
  1377. \"statement\" keywords.")
  1378.  
  1379. (defconst vhdl-statement-bwd-re
  1380.   "\\b\\(if\\|for\\|while\\)\\b"
  1381.   "A regular expression for searching backward that matches all known
  1382. \"statement\" keywords.")
  1383.  
  1384. (defun vhdl-statement-p (&optional lim)
  1385.   "Return t if we are looking at a real \"statement\" keyword.
  1386. Assumes that the caller will make sure that we are looking at
  1387. vhdl-statement-fwd-re, and are not inside a literal, and that we are not in
  1388. the middle of an identifier that just happens to contain a \"statement\"
  1389. keyword."
  1390.   (cond
  1391.    ;; "for" ... "generate":
  1392.    ((and (looking-at "f")
  1393.      ;; Make sure it's the start of a parameter specification.
  1394.      (save-excursion
  1395.        (forward-sexp 2)
  1396.        (skip-chars-forward " \t\n")
  1397.        (looking-at "in\\b[^_]"))
  1398.      ;; Make sure it's not an "end for".
  1399.      (save-excursion
  1400.        (backward-sexp)
  1401.        (not (looking-at "end\\s-+\\w"))))
  1402.     t)
  1403.    ;; "if" ... "then", "if" ... "generate", "if" ... "loop":
  1404.    ((and (looking-at "i")
  1405.      ;; Make sure it's not an "end if".
  1406.      (save-excursion
  1407.        (backward-sexp)
  1408.        (not (looking-at "end\\s-+\\w"))))
  1409.     t)
  1410.    ;; "while" ... "loop":
  1411.    ((looking-at "w")
  1412.     t)
  1413.    ))
  1414.   
  1415.  
  1416. ;; Core syntactic movement functions:
  1417.  
  1418. (defconst vhdl-b-t-b-re
  1419.   (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re))
  1420.  
  1421. (defun vhdl-backward-to-block (&optional lim)
  1422.   "Move backward to the previous \"begin\" or \"end\" keyword."
  1423.   (let (foundp)
  1424.     (while (and (not foundp)
  1425.         (re-search-backward vhdl-b-t-b-re lim 'move))
  1426.       (if (or (= (preceding-char) ?_)
  1427.           (vhdl-in-literal lim))
  1428.       (backward-char)
  1429.     (cond
  1430.      ;; "begin" keyword:
  1431.      ((and (looking-at vhdl-begin-fwd-re)
  1432.            (/= (preceding-char) ?_)
  1433.            (vhdl-begin-p lim))
  1434.       (setq foundp 'begin))
  1435.      ;; "end" keyword:
  1436.      ((and (looking-at vhdl-end-fwd-re)
  1437.            (/= (preceding-char) ?_)
  1438.            (vhdl-end-p lim))
  1439.       (setq foundp 'end))
  1440.      ))
  1441.       )
  1442.     foundp
  1443.     ))
  1444.  
  1445. (defun vhdl-forward-sexp (&optional count lim)
  1446.   "Move forward across one balanced expression (sexp).
  1447. With COUNT, do it that many times."
  1448.   (interactive "p")
  1449.   (let ((count (or count 1))
  1450.     (case-fold-search t)
  1451.     end-vec target)
  1452.     (save-excursion
  1453.       (while (> count 0)
  1454.     ;; skip whitespace
  1455.     (skip-chars-forward " \t\n")
  1456.     ;; Check for an unbalanced "end" keyword
  1457.     (if (and (looking-at vhdl-end-fwd-re)
  1458.          (/= (preceding-char) ?_)
  1459.          (not (vhdl-in-literal lim))
  1460.          (vhdl-end-p lim)
  1461.          (not (looking-at "else")))
  1462.         (error
  1463.          "Containing expression ends prematurely in vhdl-forward-sexp"))
  1464.     ;; If the current keyword is a "begin" keyword, then find the
  1465.     ;; corresponding "end" keyword.
  1466.     (if (setq end-vec (vhdl-corresponding-end lim))
  1467.         (let (
  1468.           ;; end-re is the statement keyword to search for
  1469.           (end-re
  1470.            (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)"))
  1471.           ;; column is either the statement keyword target column
  1472.           ;; or nil
  1473.           (column (aref end-vec 1))
  1474.           (eol (vhdl-point 'eol))
  1475.           foundp literal placeholder)
  1476.           ;; Look for the statement keyword.
  1477.           (while (and (not foundp)
  1478.               (re-search-forward end-re nil t)
  1479.               (setq placeholder (match-end 1))
  1480.               (goto-char (match-beginning 0)))
  1481.         ;; If we are in a literal, or not in the right target
  1482.         ;; column and not on the same line as the begin, then
  1483.         ;; try again.
  1484.         (if (or (and column
  1485.                  (/= (current-indentation) column)
  1486.                  (> (point) eol))
  1487.             (= (preceding-char) ?_)
  1488.             (setq literal (vhdl-in-literal lim)))
  1489.             (if (eq literal 'comment)
  1490.             (end-of-line)
  1491.               (forward-char))
  1492.           ;; An "else" keyword corresponds to both the opening brace
  1493.           ;; of the following sexp and the closing brace of the
  1494.           ;; previous sexp.
  1495.           (if (not (looking-at "else"))
  1496.               (goto-char placeholder))
  1497.           (setq foundp t))
  1498.         )
  1499.           (if (not foundp)
  1500.           (error "Unbalanced keywords in vhdl-forward-sexp"))
  1501.           )
  1502.       ;; If the current keyword is not a "begin" keyword, then just
  1503.       ;; perform the normal forward-sexp.
  1504.       (forward-sexp)
  1505.       )
  1506.     (setq count (1- count))
  1507.     )
  1508.       (setq target (point)))
  1509.     (goto-char target)
  1510.     nil))
  1511.  
  1512. (defun vhdl-backward-sexp (&optional count lim)
  1513.   "Move backward across one balanced expression (sexp).
  1514. With COUNT, do it that many times.  LIM bounds any required backward
  1515. searches."
  1516.   (interactive "p")
  1517.   (let ((count (or count 1))
  1518.     (case-fold-search t)
  1519.     begin-vec target)
  1520.     (save-excursion
  1521.       (while (> count 0)
  1522.     ;; Perform the normal backward-sexp, unless we are looking at
  1523.     ;; "else" - an "else" keyword corresponds to both the opening brace
  1524.     ;; of the following sexp and the closing brace of the previous sexp.
  1525.     (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
  1526.          (/= (preceding-char) ?_)
  1527.          (not (vhdl-in-literal lim)))
  1528.         nil
  1529.       (backward-sexp)
  1530.       (if (and (looking-at vhdl-begin-fwd-re)
  1531.            (/= (preceding-char) ?_)
  1532.            (not (vhdl-in-literal lim))
  1533.            (vhdl-begin-p lim))
  1534.           (error "Containing expression ends prematurely in vhdl-backward-sexp")))
  1535.     ;; If the current keyword is an "end" keyword, then find the
  1536.     ;; corresponding "begin" keyword.
  1537.     (if (and (setq begin-vec (vhdl-corresponding-begin lim))
  1538.          (/= (preceding-char) ?_))
  1539.         (let (
  1540.           ;; begin-re is the statement keyword to search for
  1541.           (begin-re
  1542.            (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]"))
  1543.           ;; column is either the statement keyword target column
  1544.           ;; or nil
  1545.           (column (aref begin-vec 1))
  1546.           ;; internal-p controls where the statement keyword can
  1547.           ;; be found.
  1548.           (internal-p (aref begin-vec 3))
  1549.           (last-backward (point)) last-forward
  1550.           foundp literal keyword)
  1551.           ;; Look for the statement keyword.
  1552.           (while (and (not foundp)
  1553.               (re-search-backward begin-re lim t)
  1554.               (setq keyword
  1555.                 (buffer-substring (match-beginning 1)
  1556.                           (match-end 1))))
  1557.         ;; If we are in a literal or in the wrong column,
  1558.         ;; then try again.
  1559.         (if (or (and column
  1560.                  (and (/= (current-indentation) column)
  1561.                   ;; possibly accept current-column as
  1562.                   ;; well as current-indentation.
  1563.                   (or (not internal-p)
  1564.                       (/= (current-column) column))))
  1565.             (= (preceding-char) ?_)
  1566.             (vhdl-in-literal lim))
  1567.             (backward-char)
  1568.           ;; If there is a supplementary keyword, then
  1569.           ;; search forward for it. 
  1570.           (if (and (setq begin-re (aref begin-vec 2))
  1571.                (or (not (listp begin-re))
  1572.                    ;; If begin-re is an alist, then find the
  1573.                    ;; element corresponding to the actual
  1574.                    ;; keyword that we found.
  1575.                    (progn
  1576.                  (setq begin-re
  1577.                        (assoc keyword begin-re))
  1578.                  (and begin-re
  1579.                       (setq begin-re (cdr begin-re))))))
  1580.               (and
  1581.                (setq begin-re
  1582.                  (concat "\\b\\(" begin-re "\\)\\b[^_]"))
  1583.                (save-excursion
  1584.              (setq last-forward (point))
  1585.              ;; Look for the supplementary keyword
  1586.              ;; (bounded by the backward search start
  1587.              ;; point).
  1588.              (while (and (not foundp)
  1589.                      (re-search-forward begin-re
  1590.                             last-backward t)
  1591.                      (goto-char (match-beginning 1)))
  1592.                ;; If we are in a literal, then try again.
  1593.                (if (or (= (preceding-char) ?_)
  1594.                    (setq literal
  1595.                      (vhdl-in-literal last-forward)))
  1596.                    (if (eq literal 'comment)
  1597.                    (goto-char
  1598.                     (min (vhdl-point 'eol) last-backward))
  1599.                  (forward-char))
  1600.                  ;; We have found the supplementary keyword.
  1601.                  ;; Save the position of the keyword in foundp.
  1602.                  (setq foundp (point)))
  1603.                )
  1604.              foundp)
  1605.                ;; If the supplementary keyword was found, then
  1606.                ;; move point to the supplementary keyword.
  1607.                (goto-char foundp))
  1608.             ;; If there was no supplementary keyword, then
  1609.             ;; point is already at the statement keyword.
  1610.             (setq foundp t)))
  1611.         ) ; end of the search for the statement keyword
  1612.           (if (not foundp)
  1613.           (error "Unbalanced keywords in vhdl-backward-sexp"))
  1614.           ))
  1615.     (setq count (1- count))
  1616.     )
  1617.       (setq target (point)))
  1618.     (goto-char target)
  1619.     nil))
  1620.  
  1621. (defun vhdl-backward-up-list (&optional count limit)
  1622.   "Move backward out of one level of blocks.
  1623. With argument, do this that many times."
  1624.   (interactive "p")
  1625.   (let ((count (or count 1))
  1626.     target)
  1627.     (save-excursion
  1628.       (while (> count 0)
  1629.     (if (looking-at vhdl-defun-re)
  1630.         (error "Unbalanced blocks"))
  1631.     (vhdl-backward-to-block limit)
  1632.     (setq count (1- count)))
  1633.       (setq target (point)))
  1634.     (goto-char target)))
  1635.  
  1636. (defun vhdl-end-of-defun (&optional count)
  1637.   "Move forward to the end of a VHDL defun."
  1638.   (interactive)
  1639.   (let ((case-fold-search t))
  1640.     (vhdl-beginning-of-defun)
  1641.     (if (not (looking-at "block\\|process"))
  1642.     (re-search-forward "\\bis\\b"))
  1643.     (vhdl-forward-sexp)))
  1644.     
  1645. (defun vhdl-mark-defun ()
  1646.   "Put mark at end of this \"defun\", point at beginning."
  1647.   (interactive)
  1648.   (let ((case-fold-search t))
  1649.     (push-mark)
  1650.     (vhdl-beginning-of-defun)
  1651.     (push-mark)
  1652.     (if (not (looking-at "block\\|process"))
  1653.     (re-search-forward "\\bis\\b"))
  1654.     (vhdl-forward-sexp)
  1655.     (exchange-point-and-mark)))
  1656.  
  1657. (defun vhdl-beginning-of-libunit ()
  1658.   "Move backward to the beginning of a VHDL library unit.
  1659. Returns the location of the corresponding begin keyword, unless search
  1660. stops due to beginning or end of buffer." 
  1661.   ;; Note that if point is between the "libunit" keyword and the
  1662.   ;; corresponding "begin" keyword, then that libunit will not be
  1663.   ;; recognised, and the search will continue backwards.  If point is
  1664.   ;; at the "begin" keyword, then the defun will be recognised.  The
  1665.   ;; returned point is at the first character of the "libunit" keyword.
  1666.   (let ((last-forward (point))
  1667.     (last-backward
  1668.      ;; Just in case we are actually sitting on the "begin"
  1669.      ;; keyword, allow for the keyword and an extra character,
  1670.      ;; as this will be used when looking forward for the
  1671.      ;; "begin" keyword.
  1672.      (save-excursion (forward-word 1) (1+ (point))))
  1673.     foundp literal placeholder)
  1674.     ;; Find the "libunit" keyword.
  1675.     (while (and (not foundp)
  1676.         (re-search-backward vhdl-libunit-re nil 'move))
  1677.       ;; If we are in a literal, or not at a real libunit, then try again.
  1678.       (if (or (= (preceding-char) ?_)
  1679.           (vhdl-in-literal (point-min))
  1680.           (not (vhdl-libunit-p)))
  1681.       (backward-char)
  1682.     ;; Find the corresponding "begin" keyword.
  1683.     (setq last-forward (point))
  1684.     (while (and (not foundp)
  1685.             (re-search-forward "\\bis\\b[^_]" last-backward t)
  1686.             (setq placeholder (match-beginning 0)))
  1687.       (if (or (= (preceding-char) ?_)
  1688.           (setq literal (vhdl-in-literal last-forward)))
  1689.           ;; It wasn't a real keyword, so keep searching.
  1690.           (if (eq literal 'comment)
  1691.           (goto-char
  1692.            (min (vhdl-point 'eol) last-backward))
  1693.         (forward-char))
  1694.         ;; We have found the begin keyword, loop will exit.
  1695.         (setq foundp placeholder)))
  1696.     ;; Go back to the libunit keyword
  1697.     (goto-char last-forward)))
  1698.     foundp))
  1699.     
  1700. (defun vhdl-beginning-of-defun (&optional count)
  1701.   "Move backward to the beginning of a VHDL defun.
  1702. With argument, do it that many times.
  1703. Returns the location of the corresponding begin keyword, unless search
  1704. stops due to beginning or end of buffer." 
  1705.   ;; Note that if point is between the "defun" keyword and the
  1706.   ;; corresponding "begin" keyword, then that defun will not be
  1707.   ;; recognised, and the search will continue backwards.  If point is
  1708.   ;; at the "begin" keyword, then the defun will be recognised.  The
  1709.   ;; returned point is at the first character of the "defun" keyword.
  1710.   (interactive "p")
  1711.   (let ((count (or count 1))
  1712.     (case-fold-search t)
  1713.     (last-forward (point))
  1714.     foundp)
  1715.     (while (> count 0)
  1716.       (setq foundp nil)
  1717.       (goto-char last-forward)
  1718.       (let ((last-backward
  1719.          ;; Just in case we are actually sitting on the "begin"
  1720.          ;; keyword, allow for the keyword and an extra character,
  1721.          ;; as this will be used when looking forward for the
  1722.          ;; "begin" keyword.
  1723.          (save-excursion (forward-word 1) (1+ (point))))
  1724.         begin-string literal)
  1725.     (while (and (not foundp)
  1726.             (re-search-backward vhdl-defun-re nil 'move))
  1727.       ;; If we are in a literal, then try again.
  1728.       (if (or (= (preceding-char) ?_)
  1729.           (vhdl-in-literal (point-min)))
  1730.           (backward-char)
  1731.         (if (setq begin-string (vhdl-corresponding-defun))
  1732.         ;; This is a real defun keyword.
  1733.         ;; Find the corresponding "begin" keyword.
  1734.         ;; Look for the begin keyword.
  1735.         (progn
  1736.           ;; Save the search start point.
  1737.           (setq last-forward (point))
  1738.           (while (and (not foundp)
  1739.                   (search-forward begin-string last-backward t))
  1740.             (if (or (= (preceding-char) ?_)
  1741.                 (save-match-data
  1742.                   (setq literal (vhdl-in-literal last-forward))))
  1743.             ;; It wasn't a real keyword, so keep searching.
  1744.             (if (eq literal 'comment)
  1745.                 (goto-char
  1746.                  (min (vhdl-point 'eol) last-backward))
  1747.               (forward-char))
  1748.               ;; We have found the begin keyword, loop will exit.
  1749.               (setq foundp (match-beginning 0)))
  1750.             )
  1751.           ;; Go back to the defun keyword
  1752.           (goto-char last-forward)) ; end search for begin keyword
  1753.           ))
  1754.       ) ; end of the search for the defun keyword
  1755.     )
  1756.       (setq count (1- count))
  1757.       )
  1758.     (vhdl-keep-region-active)
  1759.     foundp))
  1760.     
  1761. (defun vhdl-beginning-of-statement (&optional count lim)
  1762.   "Go to the beginning of the innermost VHDL statement.
  1763. With prefix arg, go back N - 1 statements.  If already at the
  1764. beginning of a statement then go to the beginning of the preceding
  1765. one.  If within a string or comment, or next to a comment (only
  1766. whitespace between), move by sentences instead of statements.
  1767.  
  1768. When called from a program, this function takes 2 optional args: the
  1769. prefix arg, and a buffer position limit which is the farthest back to
  1770. search."
  1771.   (interactive "p")
  1772.   (let ((count (or count 1))
  1773.     (case-fold-search t)
  1774.     (lim (or lim (point-min)))
  1775.     (here (point))
  1776.     state)
  1777.     (save-excursion
  1778.       (goto-char lim)
  1779.       (setq state (parse-partial-sexp (point) here nil nil)))
  1780.     (if (and (interactive-p)
  1781.          (or (nth 3 state)
  1782.          (nth 4 state)
  1783.          (looking-at (concat "[ \t]*" comment-start-skip))))
  1784.     (forward-sentence (- count))
  1785.       (while (> count 0)
  1786.     (vhdl-beginning-of-statement-1 lim)
  1787.     (setq count (1- count))))
  1788.     ;; its possible we've been left up-buf of lim
  1789.     (goto-char (max (point) lim))
  1790.     )
  1791.   (vhdl-keep-region-active))
  1792.  
  1793. (defconst vhdl-b-o-s-re
  1794.   (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|"
  1795.       vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
  1796.  
  1797. (defun vhdl-beginning-of-statement-1 (&optional lim)
  1798.   ;; move to the start of the current statement, or the previous
  1799.   ;; statement if already at the beginning of one.
  1800.   (let ((lim (or lim (point-min)))
  1801.     (here (point))
  1802.     (pos (point))
  1803.     donep)
  1804.     ;; go backwards one balanced expression, but be careful of
  1805.     ;; unbalanced paren being reached
  1806.     (if (not (vhdl-safe (progn (backward-sexp) t)))
  1807.     (progn
  1808.       (backward-up-list 1)
  1809.       (forward-char)
  1810.       (vhdl-forward-syntactic-ws here)
  1811.       (setq donep t)))
  1812.     (while (and (not donep)
  1813.         (not (bobp))
  1814.         ;; look backwards for a statement boundary
  1815.         (re-search-backward vhdl-b-o-s-re lim 'move))
  1816.       (if (or (= (preceding-char) ?_)
  1817.           (vhdl-in-literal lim))
  1818.       (backward-char)
  1819.     (cond
  1820.      ;; If we are looking at an open paren, then stop after it
  1821.      ((eq (following-char) ?\()
  1822.       (forward-char)
  1823.       (vhdl-forward-syntactic-ws here)
  1824.       (setq donep t))
  1825.      ;; If we are looking at a close paren, then skip it
  1826.      ((eq (following-char) ?\))
  1827.       (forward-char)
  1828.       (setq pos (point))
  1829.       (backward-sexp)
  1830.       (if (< (point) lim)
  1831.           (progn (goto-char pos)
  1832.              (vhdl-forward-syntactic-ws here)
  1833.              (setq donep t))))
  1834.      ;; If we are looking at a semicolon, then stop
  1835.      ((eq (following-char) ?\;)
  1836.       (progn
  1837.         (forward-char)
  1838.         (vhdl-forward-syntactic-ws here)
  1839.         (setq donep t)))
  1840.      ;; If we are looking at a "begin", then stop
  1841.      ((and (looking-at vhdl-begin-fwd-re)
  1842.            (/= (preceding-char) ?_)
  1843.            (vhdl-begin-p nil))
  1844.       ;; If it's a leader "begin", then find the
  1845.       ;; right place
  1846.       (if (looking-at vhdl-leader-re)
  1847.           (save-excursion
  1848.         ;; set a default stop point at the begin
  1849.         (setq pos (point))
  1850.         ;; is the start point inside the leader area ?
  1851.         (goto-char (vhdl-end-of-leader))
  1852.         (vhdl-forward-syntactic-ws here)
  1853.         (if (< (point) here)
  1854.             ;; start point was not inside leader area
  1855.             ;; set stop point at word after leader
  1856.             (setq pos (point))))
  1857.         (forward-word 1)
  1858.         (vhdl-forward-syntactic-ws here)
  1859.         (setq pos (point)))
  1860.       (goto-char pos)
  1861.       (setq donep t))
  1862.      ;; If we are looking at a "statement", then stop
  1863.      ((and (looking-at vhdl-statement-fwd-re)
  1864.            (/= (preceding-char) ?_)
  1865.            (vhdl-statement-p nil))
  1866.       (setq donep t))
  1867.      ;; If we are looking at a case alternative key, then stop
  1868.      ((looking-at vhdl-case-alternative-key)
  1869.       (save-excursion
  1870.         ;; set a default stop point at the when
  1871.         (setq pos (point))
  1872.         ;; is the start point inside the case alternative key ?
  1873.         (goto-char (match-end 0))
  1874.         (vhdl-forward-syntactic-ws here)
  1875.         (if (< (point) here)
  1876.         ;; start point was not inside the case alternative key
  1877.         ;; set stop point at word after case alternative keyleader
  1878.         (setq pos (point))))
  1879.       (goto-char pos)
  1880.       (setq donep t))
  1881.      ;; Bogus find, continue
  1882.      (t
  1883.       (backward-char)))))
  1884.     ))
  1885.  
  1886.  
  1887. ;; Defuns for calculating the current syntactic state:
  1888.  
  1889. (defun vhdl-get-library-unit (bod placeholder)
  1890.   ;; If there is an enclosing library unit at bod, with it's \"begin\"
  1891.   ;; keyword at placeholder, then return the library unit type.
  1892.   (let ((here (vhdl-point 'bol)))
  1893.     (if (save-excursion
  1894.       (goto-char placeholder)
  1895.       (vhdl-safe (vhdl-forward-sexp 1 bod))
  1896.       (<= here (point)))
  1897.     (save-excursion
  1898.       (goto-char bod)
  1899.       (cond
  1900.        ((looking-at "e") 'entity)
  1901.        ((looking-at "a") 'architecture)
  1902.        ((looking-at "c") 'configuration)
  1903.        ((looking-at "p")
  1904.         (save-excursion
  1905.           (goto-char bod)
  1906.           (forward-sexp)
  1907.           (vhdl-forward-syntactic-ws here)
  1908.           (if (looking-at "body\\b[^_]")
  1909.           'package-body 'package))))))
  1910.     ))
  1911.  
  1912. (defun vhdl-get-block-state (&optional lim)
  1913.   ;; Finds and records all the closest opens.
  1914.   ;; lim is the furthest back we need to search (it should be the
  1915.   ;; previous libunit keyword).
  1916.   (let ((here (point))
  1917.     (lim (or lim (point-min)))
  1918.     keyword sexp-start sexp-mid sexp-end
  1919.     preceding-sexp containing-sexp
  1920.     containing-begin containing-mid containing-paren)
  1921.     (save-excursion
  1922.       ;; Find the containing-paren, and use that as the limit
  1923.       (if (setq containing-paren
  1924.         (save-restriction
  1925.           (narrow-to-region lim (point))
  1926.           (vhdl-safe (scan-lists (point) -1 1))))
  1927.       (setq lim containing-paren))
  1928.       ;; Look backwards for "begin" and "end" keywords.
  1929.       (while (and (> (point) lim)
  1930.           (not containing-sexp))
  1931.     (setq keyword (vhdl-backward-to-block lim))
  1932.     (cond
  1933.      ((eq keyword 'begin)
  1934.       ;; Found a "begin" keyword
  1935.       (setq sexp-start (point))
  1936.       (setq sexp-mid (vhdl-corresponding-mid lim))
  1937.       (setq sexp-end (vhdl-safe
  1938.               (save-excursion
  1939.                 (vhdl-forward-sexp 1 lim) (point))))
  1940.       (if (and sexp-end (<= sexp-end here))
  1941.           ;; we want to record this sexp, but we only want to
  1942.           ;; record the last-most of any of them before here
  1943.           (or preceding-sexp
  1944.           (setq preceding-sexp sexp-start))
  1945.         ;; we're contained in this sexp so put sexp-start on
  1946.         ;; front of list
  1947.         (setq containing-sexp sexp-start)
  1948.         (setq containing-mid sexp-mid)
  1949.         (setq containing-begin t)))
  1950.      ((eq keyword 'end)
  1951.       ;; Found an "end" keyword
  1952.       (forward-sexp)
  1953.       (setq sexp-end (point))
  1954.       (setq sexp-mid nil)
  1955.       (setq sexp-start
  1956.         (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point))
  1957.             (progn (backward-sexp) (point))))
  1958.       ;; we want to record this sexp, but we only want to
  1959.       ;; record the last-most of any of them before here
  1960.       (or preceding-sexp
  1961.           (setq preceding-sexp sexp-start)))
  1962.      )))
  1963.     ;; Check if the containing-paren should be the containing-sexp
  1964.     (if (and containing-paren
  1965.          (or (null containing-sexp)
  1966.          (< containing-sexp containing-paren)))
  1967.     (setq containing-sexp containing-paren
  1968.           preceding-sexp nil
  1969.           containing-begin nil
  1970.           containing-mid nil))
  1971.     (vector containing-sexp preceding-sexp containing-begin containing-mid)
  1972.     ))
  1973.           
  1974.  
  1975. (defconst vhdl-s-c-a-re
  1976.   (concat vhdl-case-alternative-key "\\|" vhdl-case-header-key))
  1977.  
  1978. (defun vhdl-skip-case-alternative (&optional lim)
  1979.   ;; skip forward over case/when bodies, with optional maximal
  1980.   ;; limit. if no next case alternative is found, nil is returned and point
  1981.   ;; is not moved
  1982.   (let ((lim (or lim (point-max)))
  1983.     (here (point))
  1984.     donep foundp)
  1985.     (while (and (< (point) lim)
  1986.         (not donep))
  1987.       (if (and (re-search-forward vhdl-s-c-a-re lim 'move)
  1988.            (save-match-data
  1989.          (not (vhdl-in-literal)))
  1990.            (/= (match-beginning 0) here))
  1991.       (progn
  1992.         (goto-char (match-beginning 0))
  1993.         (cond
  1994.          ((and (looking-at "case")
  1995.            (re-search-forward "\\bis[^_]" lim t))
  1996.           (backward-sexp)
  1997.           (vhdl-forward-sexp))
  1998.          (t
  1999.           (setq donep t
  2000.             foundp t))))))
  2001.     (if (not foundp)
  2002.     (goto-char here))
  2003.     foundp))
  2004.  
  2005. (defun vhdl-backward-skip-label (&optional lim)
  2006.   ;; skip backward over a label, with optional maximal
  2007.   ;; limit. if label is found, nil is returned and point
  2008.   ;; is not moved
  2009.   (let ((lim (or lim (point-min)))
  2010.     placeholder)
  2011.     (if (save-excursion
  2012.       (vhdl-backward-syntactic-ws lim)
  2013.       (and (eq (preceding-char) ?:)
  2014.            (progn
  2015.          (backward-sexp)
  2016.          (setq placeholder (point))
  2017.          (looking-at vhdl-label-key))))
  2018.     (goto-char placeholder))
  2019.     ))
  2020.  
  2021. (defun vhdl-get-syntactic-context ()
  2022.   ;; guess the syntactic description of the current line of VHDL code.
  2023.   (save-excursion
  2024.     (save-restriction
  2025.       (beginning-of-line)
  2026.       (let* ((indent-point (point))
  2027.          (case-fold-search t)
  2028.          vec literal containing-sexp preceding-sexp
  2029.          containing-begin containing-mid containing-leader
  2030.          char-before-ip char-after-ip begin-after-ip end-after-ip
  2031.          placeholder lim library-unit
  2032.         )
  2033.  
  2034.     ;; Reset the syntactic context
  2035.     (setq vhdl-syntactic-context nil)
  2036.  
  2037.     (save-excursion
  2038.       ;; Move to the start of the previous library unit, and
  2039.       ;; record the position of the "begin" keyword.
  2040.       (setq placeholder (vhdl-beginning-of-libunit))
  2041.       ;; The position of the "libunit" keyword gives us a gross
  2042.       ;; limit point.
  2043.       (setq lim (point))
  2044.       )
  2045.  
  2046.     ;; If there is a previous library unit, and we are enclosed by
  2047.     ;; it, then set the syntax accordingly.
  2048.     (and placeholder
  2049.          (setq library-unit (vhdl-get-library-unit lim placeholder))
  2050.          (vhdl-add-syntax library-unit lim))
  2051.         
  2052.     ;; Find the surrounding state.
  2053.     (if (setq vec (vhdl-get-block-state lim))
  2054.         (progn
  2055.           (setq containing-sexp (aref vec 0))
  2056.           (setq preceding-sexp (aref vec 1))
  2057.           (setq containing-begin (aref vec 2))
  2058.           (setq containing-mid (aref vec 3))
  2059.           ))
  2060.  
  2061.     ;; set the limit on the farthest back we need to search
  2062.     (setq lim (if containing-sexp
  2063.               (save-excursion
  2064.             (goto-char containing-sexp)
  2065.             ;; set containing-leader if required
  2066.             (if (looking-at vhdl-leader-re)
  2067.                 (setq containing-leader (vhdl-end-of-leader)))
  2068.             (vhdl-point 'bol))
  2069.             (point-min)))
  2070.  
  2071.     ;; cache char before and after indent point, and move point to
  2072.     ;; the most likely position to perform the majority of tests
  2073.     (goto-char indent-point)
  2074.     (skip-chars-forward " \t")
  2075.     (setq literal (vhdl-in-literal lim))
  2076.     (setq char-after-ip (following-char))
  2077.     (setq begin-after-ip (and
  2078.                   (not literal)
  2079.                   (looking-at vhdl-begin-fwd-re)
  2080.                   (vhdl-begin-p)))
  2081.     (setq end-after-ip (and
  2082.                 (not literal)
  2083.                 (looking-at vhdl-end-fwd-re)
  2084.                 (vhdl-end-p)))
  2085.     (vhdl-backward-syntactic-ws lim)
  2086.     (setq char-before-ip (preceding-char))
  2087.     (goto-char indent-point)
  2088.     (skip-chars-forward " \t")
  2089.  
  2090.     ;; now figure out syntactic qualities of the current line
  2091.     (cond
  2092.      ;; CASE 1: in a string or comment.
  2093.      ((memq literal '(string comment))
  2094.       (vhdl-add-syntax literal (vhdl-point 'bopl)))
  2095.      ;; CASE 2: Line is at top level.
  2096.      ((null containing-sexp)
  2097.       ;; Find the point to which indentation will be relative
  2098.       (save-excursion
  2099.         (if (null preceding-sexp)
  2100.         ;; CASE 2X.1
  2101.         ;; no preceding-sexp -> use the preceding statement
  2102.         (vhdl-beginning-of-statement-1 lim)
  2103.           ;; CASE 2X.2
  2104.           ;; if there is a preceding-sexp then indent relative to it
  2105.           (goto-char preceding-sexp)
  2106.           ;; if not at boi, then the block-opening keyword is
  2107.           ;; probably following a label, so we need a different
  2108.           ;; relpos
  2109.           (if (/= (point) (vhdl-point 'boi))
  2110.           ;; CASE 2X.3
  2111.           (vhdl-beginning-of-statement-1 lim)))
  2112.         ;; v-b-o-s could have left us at point-min
  2113.         (and (bobp)
  2114.          ;; CASE 2X.4
  2115.          (vhdl-forward-syntactic-ws indent-point))
  2116.         (setq placeholder (point)))
  2117.       (cond
  2118.        ;; CASE 2A : we are looking at a block-open
  2119.        (begin-after-ip
  2120.         (vhdl-add-syntax 'block-open placeholder))
  2121.        ;; CASE 2B: we are looking at a block-close
  2122.        (end-after-ip
  2123.         (vhdl-add-syntax 'block-close placeholder))
  2124.        ;; CASE 2C: we are looking at a top-level statement
  2125.        ((progn
  2126.           (vhdl-backward-syntactic-ws lim)
  2127.           (or (bobp)
  2128.           (= (preceding-char) ?\;)))
  2129.         (vhdl-add-syntax 'statement placeholder))
  2130.        ;; CASE 2D: we are looking at a top-level statement-cont
  2131.        (t
  2132.         (vhdl-beginning-of-statement-1 lim)
  2133.         ;; v-b-o-s could have left us at point-min
  2134.         (and (bobp)
  2135.          ;; CASE 2D.1
  2136.          (vhdl-forward-syntactic-ws indent-point))
  2137.         (vhdl-add-syntax 'statement-cont (point)))
  2138.        )) ; end CASE 2
  2139.      ;; CASE 3: line is inside parentheses.  Most likely we are
  2140.      ;; either in a subprogram argument (interface) list, or a
  2141.      ;; continued expression containing parentheses.
  2142.      ((null containing-begin)
  2143.       (vhdl-backward-syntactic-ws containing-sexp)
  2144.       (cond
  2145.        ;; CASE 3A: we are looking at the arglist closing paren
  2146.        ((eq char-after-ip ?\))
  2147.         (goto-char containing-sexp)
  2148.         (vhdl-add-syntax 'arglist-close (vhdl-point 'boi)))
  2149.        ;; CASE 3B: we are looking at the first argument in an empty
  2150.        ;; argument list.
  2151.        ((eq char-before-ip ?\()
  2152.         (goto-char containing-sexp)
  2153.         (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi)))
  2154.        ;; CASE 3C: we are looking at an arglist continuation line,
  2155.        ;; but the preceding argument is on the same line as the
  2156.        ;; opening paren.  This case includes multi-line
  2157.        ;; expression paren groupings.
  2158.        ((and (save-excursion
  2159.            (goto-char (1+ containing-sexp))
  2160.            (skip-chars-forward " \t")
  2161.            (not (eolp))
  2162.            (not (looking-at "--")))
  2163.          (save-excursion
  2164.            (vhdl-beginning-of-statement-1 containing-sexp)
  2165.            (skip-chars-backward " \t(")
  2166.            (<= (point) containing-sexp)))
  2167.         (goto-char containing-sexp)
  2168.         (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
  2169.        ;; CASE 3D: we are looking at just a normal arglist
  2170.        ;; continuation line
  2171.        (t (vhdl-beginning-of-statement-1 containing-sexp)
  2172.           (vhdl-forward-syntactic-ws indent-point)
  2173.           (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi)))
  2174.        ))
  2175.      ;; CASE 4: A block mid open
  2176.      ((and begin-after-ip
  2177.            (looking-at containing-mid))
  2178.       (goto-char containing-sexp)
  2179.       ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
  2180.       (if (looking-at vhdl-trailer-re)
  2181.           ;; CASE 4.1
  2182.           (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
  2183.       (vhdl-backward-skip-label (vhdl-point 'boi))
  2184.       (vhdl-add-syntax 'block-open (point)))
  2185.      ;; CASE 5: block close brace
  2186.      (end-after-ip
  2187.       (goto-char containing-sexp)
  2188.       ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
  2189.       (if (looking-at vhdl-trailer-re)
  2190.           ;; CASE 5.1
  2191.           (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
  2192.       (vhdl-backward-skip-label (vhdl-point 'boi))
  2193.       (vhdl-add-syntax 'block-close (point)))
  2194.      ;; CASE 6: A continued statement
  2195.      ((and (/= char-before-ip ?\;)
  2196.            ;; check it's not a trailer begin keyword, or a begin
  2197.            ;; keyword immediately following a label.
  2198.            (not (and begin-after-ip
  2199.              (or (looking-at vhdl-trailer-re)
  2200.                  (save-excursion
  2201.                    (vhdl-backward-skip-label containing-sexp)))))
  2202.            ;; check it's not a statement keyword
  2203.            (not (and (looking-at vhdl-statement-fwd-re)
  2204.              (vhdl-statement-p)))
  2205.            ;; see if the b-o-s is before the indent point
  2206.            (> indent-point
  2207.           (save-excursion
  2208.             (vhdl-beginning-of-statement-1 containing-sexp)
  2209.             ;; If we ended up after a leader, then this will
  2210.             ;; move us forward to the start of the first
  2211.             ;; statement.  Note that a containing sexp here is
  2212.             ;; always a keyword, not a paren, so this will
  2213.             ;; have no effect if we hit the containing-sexp.
  2214.             (vhdl-forward-syntactic-ws indent-point)
  2215.             (setq placeholder (point))))
  2216.            ;; check it's not a block-intro
  2217.            (/= placeholder containing-sexp)
  2218.            ;; check it's not a case block-intro
  2219.            (save-excursion
  2220.          (goto-char placeholder)
  2221.          (or (not (looking-at vhdl-case-alternative-key))
  2222.              (> (match-end 0) indent-point))))
  2223.       (vhdl-add-syntax 'statement-cont placeholder)
  2224.       (if begin-after-ip
  2225.           (vhdl-add-syntax 'block-open)))
  2226.      ;; Statement. But what kind?
  2227.      ;; CASE 7: A case alternative key
  2228.      ((looking-at vhdl-case-alternative-key)
  2229.       ;; for a case alternative key, we set relpos to the first
  2230.       ;; non-whitespace char on the line containing the "case"
  2231.       ;; keyword.
  2232.       (goto-char containing-sexp)
  2233.       ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
  2234.       (if (looking-at vhdl-trailer-re)
  2235.           (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
  2236.       (vhdl-add-syntax 'case-alternative (vhdl-point 'boi)))
  2237.      ;; CASE 8: statement catchall
  2238.      (t
  2239.       ;; we know its a statement, but we need to find out if it is
  2240.       ;; the first statement in a block
  2241.       (if containing-leader
  2242.           (goto-char containing-leader)
  2243.         (goto-char containing-sexp)
  2244.         ;; Note that a containing sexp here is always a keyword,
  2245.         ;; not a paren, so skip over the keyword.
  2246.         (forward-sexp))
  2247.       ;; move to the start of the first statement
  2248.       (vhdl-forward-syntactic-ws indent-point)
  2249.       (setq placeholder (point))
  2250.       ;; we want to ignore case alternatives keys when skipping forward
  2251.       (let (incase-p)
  2252.         (while (looking-at vhdl-case-alternative-key)
  2253.           (setq incase-p (point))
  2254.           ;; we also want to skip over the body of the
  2255.           ;; case/when statement if that doesn't put us at
  2256.           ;; after the indent-point
  2257.           (while (vhdl-skip-case-alternative indent-point))
  2258.           ;; set up the match end
  2259.           (looking-at vhdl-case-alternative-key)
  2260.           (goto-char (match-end 0))
  2261.           ;; move to the start of the first case alternative statement
  2262.           (vhdl-forward-syntactic-ws indent-point)
  2263.           (setq placeholder (point)))
  2264.         (cond
  2265.          ;; CASE 8A: we saw a case/when statement so we must be
  2266.          ;; in a switch statement.  find out if we are at the
  2267.          ;; statement just after a case alternative key
  2268.          ((and incase-p
  2269.            (= (point) indent-point))
  2270.           ;; relpos is the "when" keyword
  2271.           (vhdl-add-syntax 'statement-case-intro incase-p))
  2272.          ;; CASE 8B: any old statement
  2273.          ((< (point) indent-point)
  2274.           ;; relpos is the first statement of the block
  2275.           (vhdl-add-syntax 'statement placeholder)
  2276.           (if begin-after-ip
  2277.           (vhdl-add-syntax 'block-open)))
  2278.          ;; CASE 8C: first statement in a block
  2279.          (t
  2280.           (goto-char containing-sexp)
  2281.           ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
  2282.           (if (looking-at vhdl-trailer-re)
  2283.           (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
  2284.           (vhdl-backward-skip-label (vhdl-point 'boi))
  2285.           (vhdl-add-syntax 'statement-block-intro (point))
  2286.           (if begin-after-ip
  2287.           (vhdl-add-syntax 'block-open)))
  2288.          )))
  2289.      )
  2290.  
  2291.     ;; now we need to look at any modifiers
  2292.     (goto-char indent-point)
  2293.     (skip-chars-forward " \t")
  2294.     (if (looking-at "--")
  2295.         (vhdl-add-syntax 'comment))
  2296.     ;; return the syntax
  2297.     vhdl-syntactic-context))))
  2298.  
  2299.  
  2300. ;; Standard indentation line-ups:
  2301.  
  2302. (defun vhdl-lineup-arglist (langelem)
  2303.   ;; lineup the current arglist line with the arglist appearing just
  2304.   ;; after the containing paren which starts the arglist.
  2305.   (save-excursion
  2306.     (let* ((containing-sexp
  2307.         (save-excursion
  2308.           ;; arglist-cont-nonempty gives relpos ==
  2309.           ;; to boi of containing-sexp paren. This
  2310.           ;; is good when offset is +, but bad
  2311.           ;; when it is vhdl-lineup-arglist, so we
  2312.           ;; have to special case a kludge here.
  2313.           (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty))
  2314.           (progn
  2315.             (beginning-of-line)
  2316.             (backward-up-list 1)
  2317.             (skip-chars-forward " \t" (vhdl-point 'eol)))
  2318.         (goto-char (cdr langelem)))
  2319.           (point)))
  2320.        (cs-curcol (save-excursion
  2321.             (goto-char (cdr langelem))
  2322.             (current-column))))
  2323.       (if (save-excursion
  2324.         (beginning-of-line)
  2325.         (looking-at "[ \t]*)"))
  2326.       (progn (goto-char (match-end 0))
  2327.          (backward-sexp)
  2328.          (forward-char)
  2329.          (vhdl-forward-syntactic-ws)
  2330.          (- (current-column) cs-curcol))
  2331.     (goto-char containing-sexp)
  2332.     (or (eolp)
  2333.         (let ((eol (vhdl-point 'eol))
  2334.           (here (progn
  2335.               (forward-char)
  2336.               (skip-chars-forward " \t")
  2337.               (point))))
  2338.           (vhdl-forward-syntactic-ws)
  2339.           (if (< (point) eol)
  2340.           (goto-char here))))
  2341.     (- (current-column) cs-curcol)
  2342.     ))))
  2343.  
  2344. (defun vhdl-lineup-arglist-intro (langelem)
  2345.   ;; lineup an arglist-intro line to just after the open paren
  2346.   (save-excursion
  2347.     (let ((cs-curcol (save-excursion
  2348.                (goto-char (cdr langelem))
  2349.                (current-column)))
  2350.       (ce-curcol (save-excursion
  2351.                (beginning-of-line)
  2352.                (backward-up-list 1)
  2353.                (skip-chars-forward " \t" (vhdl-point 'eol))
  2354.                (current-column))))
  2355.       (- ce-curcol cs-curcol -1))))
  2356.  
  2357. (defun vhdl-lineup-comment (langelem)
  2358.   ;; support old behavior for comment indentation. we look at
  2359.   ;; vhdl-comment-only-line-offset to decide how to indent comment
  2360.   ;; only-lines
  2361.   (save-excursion
  2362.     (back-to-indentation)
  2363.     ;; at or to the right of comment-column
  2364.     (if (>= (current-column) comment-column)
  2365.     (vhdl-comment-indent)
  2366.       ;; otherwise, indent as specified by vhdl-comment-only-line-offset
  2367.       (if (not (bolp))
  2368.       (or (car-safe vhdl-comment-only-line-offset)
  2369.           vhdl-comment-only-line-offset)
  2370.     (or (cdr-safe vhdl-comment-only-line-offset)
  2371.         (car-safe vhdl-comment-only-line-offset)
  2372.         -1000            ;jam it against the left side
  2373.         )))))
  2374.  
  2375. (defun vhdl-lineup-statement-cont (langelem)
  2376.   ;; line up statement-cont after the assignment operator
  2377.   (save-excursion
  2378.     (let* ((relpos (cdr langelem))
  2379.        (assignp (save-excursion
  2380.              (goto-char (vhdl-point 'boi))
  2381.              (and (re-search-forward "\\(<\\|:\\)="
  2382.                          (vhdl-point 'eol) t)
  2383.               (- (point) (vhdl-point 'boi)))))
  2384.        (curcol (progn
  2385.              (goto-char relpos)
  2386.              (current-column)))
  2387.        foundp)
  2388.       (while (and (not foundp)
  2389.           (< (point) (vhdl-point 'eol)))
  2390.     (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move)
  2391.     (if (vhdl-in-literal (cdr langelem))
  2392.         (forward-char)
  2393.       (if (= (preceding-char) ?\()
  2394.           ;; skip over any parenthesized expressions
  2395.           (goto-char (min (vhdl-point 'eol)
  2396.                   (scan-lists (point) 1 1)))
  2397.         ;; found an assignment operator (not at eol)
  2398.         (setq foundp (not (looking-at "\\s-*$"))))))
  2399.       (if (not foundp)
  2400.       ;; there's no assignment operator on the line
  2401.       vhdl-basic-offset
  2402.     ;; calculate indentation column after assign and ws, unless
  2403.     ;; our line contains an assignment operator
  2404.     (if (not assignp)
  2405.         (progn
  2406.           (forward-char)
  2407.           (skip-chars-forward " \t")
  2408.           (setq assignp 0)))
  2409.     (- (current-column) assignp curcol))
  2410.       )))
  2411.  
  2412.  
  2413. ;; Indentation commands:
  2414.  
  2415. ;; This is used by indent-for-comment to decide how much to indent a
  2416. ;; comment in VHDL code based on its context.
  2417. (defun vhdl-comment-indent ()
  2418.   (if (looking-at (concat "^--"))
  2419.       0                ;Existing comment at bol stays there.
  2420.     (let ((opoint (point))
  2421.       placeholder)
  2422.       (save-excursion
  2423.     (beginning-of-line)
  2424.     (cond
  2425.      ;; CASE 1: use comment-column if previous line is a
  2426.      ;; comment-only line indented to the left of comment-column
  2427.      ((save-excursion
  2428.         (beginning-of-line)
  2429.         (and (not (bobp))
  2430.          (forward-line -1))
  2431.         (skip-chars-forward " \t")
  2432.         (prog1
  2433.         (looking-at "--")
  2434.           (setq placeholder (point))))
  2435.       (goto-char placeholder)
  2436.       (if (< (current-column) comment-column)
  2437.           comment-column
  2438.         (current-column)))
  2439.      ;; CASE 2: If comment-column is 0, and nothing but space
  2440.      ;; before the comment, align it at 0 rather than 1.
  2441.      ((progn
  2442.         (goto-char opoint)
  2443.         (skip-chars-backward " \t")
  2444.         (and (= comment-column 0) (bolp)))
  2445.       0)
  2446.      ;; CASE 3: indent at comment column except leave at least one
  2447.      ;; space.
  2448.      (t (max (1+ (current-column))
  2449.          comment-column))
  2450.      )))))
  2451.  
  2452. (defun vhdl-indent-line ()
  2453.   ;; indent the current line as VHDL code. Returns the amount of
  2454.   ;; indentation change
  2455.   (let* ((syntax (vhdl-get-syntactic-context))
  2456.      (pos (- (point-max) (point)))
  2457.      (indent (apply '+ (mapcar 'vhdl-get-offset syntax)))
  2458.      (shift-amt  (- (current-indentation) indent)))
  2459.     (and vhdl-echo-syntactic-information-p
  2460.      (message "syntax: %s, indent= %d" syntax indent))
  2461.     (if (zerop shift-amt)
  2462.     nil
  2463.       (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
  2464.       (beginning-of-line)
  2465.       (indent-to indent))
  2466.     (if (< (point) (vhdl-point 'boi))
  2467.     (back-to-indentation)
  2468.       ;; If initial point was within line's indentation, position after
  2469.       ;; the indentation.  Else stay at same point in text.
  2470.       (if (> (- (point-max) pos) (point))
  2471.       (goto-char (- (point-max) pos)))
  2472.       )
  2473.     (run-hooks 'vhdl-special-indent-hook)
  2474.     shift-amt))
  2475.  
  2476. (defun vhdl-indent-command (&optional whole-exp)
  2477.   "Indent current line as VHDL code, or in some cases insert a tab character.
  2478.  
  2479. If `vhdl-tab-always-indent' is t, always just indent the current line.
  2480. If nil, indent the current line only if point is at the left margin or
  2481. in the line's indentation; otherwise insert a tab.  If other than nil
  2482. or t, then tab is inserted only within literals (comments and strings)
  2483. and inside preprocessor directives, but line is always reindented.
  2484.  
  2485. A numeric argument, regardless of its value, means indent rigidly all
  2486. the lines of the expression starting after point so that this line
  2487. becomes properly indented.  The relative indentation among the lines
  2488. of the expression are preserved."
  2489.   (interactive "P")
  2490.   (if whole-exp
  2491.       ;; If arg, always indent this line as VHDL
  2492.       ;; and shift remaining lines of expression the same amount.
  2493.       (let ((shift-amt (vhdl-indent-line))
  2494.         beg end)
  2495.     (save-excursion
  2496.       (if (eq vhdl-tab-always-indent t)
  2497.           (beginning-of-line))
  2498.       (setq beg (point))
  2499.       (forward-sexp)
  2500.       (setq end (point))
  2501.       (goto-char beg)
  2502.       (forward-line 1)
  2503.       (setq beg (point)))
  2504.     (if (> end beg)
  2505.         (indent-code-rigidly beg end (- shift-amt))))
  2506.     ;; No arg supplied, use vhdl-tab-always-indent to determine
  2507.     ;; behavior
  2508.     (cond
  2509.      ;; CASE 1: indent when at column zero or in lines indentation,
  2510.      ;; otherwise insert a tab
  2511.      ((not vhdl-tab-always-indent)
  2512.       (if (save-excursion
  2513.         (skip-chars-backward " \t")
  2514.         (not (bolp)))
  2515.       (insert-tab)
  2516.     (vhdl-indent-line)))
  2517.      ;; CASE 2: just indent the line
  2518.      ((eq vhdl-tab-always-indent t)
  2519.       (vhdl-indent-line))
  2520.      ;; CASE 3: if in a literal, insert a tab, but always indent the
  2521.      ;; line
  2522.      (t
  2523.       (if (vhdl-in-literal (vhdl-point 'bod))
  2524.       (insert-tab))
  2525.       (vhdl-indent-line)
  2526.       ))))
  2527.  
  2528. (defun vhdl-indent-sexp (&optional endpos)
  2529.   "Indent each line of the list starting just after point.
  2530. If optional arg ENDPOS is given, indent each line, stopping when
  2531. ENDPOS is encountered.  (interactive)"
  2532.   (interactive)
  2533.   (save-excursion
  2534.     (let ((beg (point))
  2535.       (end (progn
  2536.          (vhdl-forward-sexp nil endpos)
  2537.          (point))))
  2538.       (indent-region beg end nil))))
  2539.  
  2540. (defun vhdl-show-syntactic-information ()
  2541.   "Show syntactic information for current line."
  2542.   (interactive)
  2543.   (message "syntactic analysis: %s" (vhdl-get-syntactic-context))
  2544.   (vhdl-keep-region-active))
  2545.  
  2546.  
  2547. ;; Verification and regression functions:
  2548.  
  2549. (defun vhdl-regress-line (&optional arg)
  2550.   "Check syntactic information for current line."
  2551.   (interactive "P")
  2552.   (let ((expected (save-excursion
  2553.             (end-of-line)
  2554.             (if (search-backward " -- ((" (vhdl-point 'bol) t)
  2555.             (progn
  2556.               (forward-char 4)
  2557.               (read (current-buffer))))))
  2558.     (actual (vhdl-get-syntactic-context))
  2559.     (expurgated))
  2560.     ;; remove the library unit symbols
  2561.     (mapcar
  2562.      (function
  2563.       (lambda (elt)
  2564.     (if (memq (car elt) '(entity configuration package
  2565.                      package-body architecture))
  2566.         nil
  2567.       (setq expurgated (append expurgated (list elt))))))
  2568.      actual)
  2569.     (if (and (not arg) expected (listp expected))
  2570.     (if (not (equal expected expurgated))
  2571.         (error "Should be: %s, is: %s" expected expurgated))
  2572.       (save-excursion
  2573.     (beginning-of-line)
  2574.     (if (not (looking-at "^\\s-*\\(--.*\\)?$"))
  2575.         (progn
  2576.           (end-of-line)
  2577.           (if (search-backward " -- ((" (vhdl-point 'bol) t)
  2578.           (kill-line))
  2579.           (insert " -- ")
  2580.           (insert (format "%s" expurgated)))))))
  2581.   (vhdl-keep-region-active))
  2582.  
  2583. (defun test-vhdl-get-block-state ()
  2584.   (interactive)
  2585.   (let ((case-fold-search t)
  2586.     here vec (delay 0.5))
  2587.     (setq here (point))
  2588.     (message "%s" (prin1-to-string (setq vec (vhdl-get-block-state))))
  2589.     (and (aref vec 0)
  2590.      (goto-char (aref vec 0))
  2591.      (sit-for delay))
  2592.     (and (aref vec 1)
  2593.      (goto-char (aref vec 1))
  2594.      (sit-for delay))
  2595.     (goto-char here)
  2596.     ))
  2597.  
  2598. ;; Support for Barry Warsaw's elp (emacs lisp profiler) package:
  2599.  
  2600. (eval-when-compile
  2601.   (require 'elp))
  2602.  
  2603. (setq elp-all-instrumented-list nil)
  2604. (setq elp-function-list
  2605.       '(
  2606.     vhdl-indent-command
  2607.     vhdl-indent-line
  2608.     vhdl-comment-indent
  2609.     vhdl-lineup-statement-cont
  2610.     vhdl-lineup-comment
  2611.     vhdl-lineup-arglist-intro
  2612.     vhdl-lineup-arglist
  2613.     vhdl-get-syntactic-context
  2614.     vhdl-skip-case-alternative
  2615.     vhdl-get-block-state
  2616.     vhdl-get-library-unit
  2617.     vhdl-beginning-of-statement
  2618.     vhdl-beginning-of-statement-1
  2619.     vhdl-beginning-of-defun
  2620.     vhdl-beginning-of-libunit
  2621.     vhdl-backward-sexp
  2622.     vhdl-forward-sexp
  2623.     vhdl-backward-to-block
  2624.     vhdl-statement-p
  2625.     vhdl-end-of-leader
  2626.     vhdl-corresponding-begin
  2627.     vhdl-end-p
  2628.     vhdl-corresponding-end
  2629.     vhdl-corresponding-mid
  2630.     vhdl-begin-p
  2631.     vhdl-corresponding-defun
  2632.     vhdl-defun-p
  2633.     vhdl-libunit-p
  2634.     vhdl-last-word
  2635.     vhdl-first-word
  2636.     vhdl-backward-syntactic-ws
  2637.     vhdl-forward-syntactic-ws
  2638.     vhdl-in-literal
  2639.     vhdl-keep-region-active
  2640.     ))
  2641.  
  2642. ;; (elp-instrument-list elp-function-list)
  2643.  
  2644. (defun vhdl-trace-all-functions ()
  2645.   (interactive)
  2646.   (let ((list elp-function-list))
  2647.     (while list
  2648.       (trace-function-background (car list))
  2649.       (setq list (cdr list)))))
  2650.  
  2651.  
  2652. ;; Defuns for submitting bug reports:
  2653.  
  2654. (defconst vhdl-version "$Revision: 2.74 $"
  2655.   "vhdl-mode version number.")
  2656. (defconst vhdl-mode-help-address "rwhitby@geocities.com"
  2657.   "Address accepting submission of bug reports.")
  2658.  
  2659. (defun vhdl-version ()
  2660.   "Echo the current version of vhdl-mode in the minibuffer."
  2661.   (interactive)
  2662.   (message "Using vhdl-mode %s" vhdl-version)
  2663.   (vhdl-keep-region-active))
  2664.  
  2665. ;; get reporter-submit-bug-report when byte-compiling
  2666. (and (fboundp 'eval-when-compile)
  2667.      (eval-when-compile
  2668.       (require 'reporter)))
  2669.  
  2670. (defun vhdl-submit-bug-report ()
  2671.   "Submit via mail a bug report on vhdl-mode."
  2672.   (interactive)
  2673.   ;; load in reporter
  2674.   (and
  2675.    (y-or-n-p "Do you want to submit a report on vhdl-mode? ")
  2676.    (require 'reporter)
  2677.    (reporter-submit-bug-report
  2678.     vhdl-mode-help-address
  2679.     (concat "vhdl-mode " vhdl-version)
  2680.     (list
  2681.      ;; report only the vars that affect indentation
  2682.      'vhdl-basic-offset
  2683.      'vhdl-offsets-alist
  2684.      'vhdl-comment-only-line-offset
  2685.      'vhdl-tab-always-indent
  2686.      'tab-width
  2687.      )
  2688.     (function
  2689.      (lambda ()
  2690.        (insert
  2691.     (if vhdl-special-indent-hook
  2692.         (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
  2693.             "vhdl-special-indent-hook is set to '"
  2694.             (format "%s" vhdl-special-indent-hook)
  2695.             ".\nPerhaps this is your problem?\n"
  2696.             "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
  2697.       "\n")
  2698.     (format "vhdl-emacs-features: %s\n" vhdl-emacs-features)
  2699.     )))
  2700.     nil
  2701.     "Dear Rod,"
  2702.     )))
  2703.  
  2704. (provide 'vhdl-mode)
  2705. ;;; vhdl-mode.el ends here
  2706.